commit 0dd2defc2c19b09ba71bf4d4f813c5402fe31837 (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Wed Jun 19 07:22:54 2024 +0200 ; Delete redundant and/or misleading package headers * lisp/erc/erc-backend.el: * lisp/hfy-cmap.el: * lisp/htmlfontify.el: * lisp/net/newst-backend.el: * lisp/net/newst-plainview.el: * lisp/net/newst-reader.el: * lisp/net/newst-ticker.el: * lisp/net/newst-treeview.el: * lisp/net/newsticker.el: * lisp/use-package/use-package-ensure-system-package.el: * lisp/wdired.el: Delete redundant and/or misleading package headers. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index a4a78c66b02..a75ceffb6c8 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2,7 +2,6 @@ ;; Copyright (C) 2004-2024 Free Software Foundation, Inc. -;; Filename: erc-backend.el ;; Author: Lawrence Mitchell ;; Maintainer: Amin Bandali , F. Jason Park ;; Created: 2004-05-7 diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el index ee8eac6732a..e9956222e9c 100644 --- a/lisp/hfy-cmap.el +++ b/lisp/hfy-cmap.el @@ -1,16 +1,12 @@ ;;; hfy-cmap.el --- Fallback color name -> rgb mapping for `htmlfontify' -*- lexical-binding:t -*- -;; Copyright (C) 2002-2003, 2009-2024 Free Software Foundation, Inc. +;; Copyright (C) 2002-2024 Free Software Foundation, Inc. -;; Emacs Lisp Archive Entry ;; Package: htmlfontify -;; Filename: hfy-cmap.el ;; Keywords: color, rgb ;; Author: Vivek Dasmohapatra ;; Created: 2002-01-20 -;; Description: fallback code for color name -> rgb mapping ;; URL: http://rtfm.etla.org/emacs/htmlfontify/ -;; Last-Updated: Sat 2003-02-15 03:49:32 +0000 ;; This file is part of GNU Emacs. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index d411b6213c8..53cb00eb1ba 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -2,14 +2,11 @@ ;; Copyright (C) 2002-2024 Free Software Foundation, Inc. -;; Emacs Lisp Archive Entry ;; Package: htmlfontify -;; Filename: htmlfontify.el ;; Old-Version: 0.21 ;; Keywords: html, hypermedia, markup, etags ;; Author: Vivek Dasmohapatra ;; Created: 2002-01-05 -;; Description: htmlize a buffer/source tree with optional hyperlinks ;; URL: http://rtfm.etla.org/emacs/htmlfontify/ ;; This file is part of GNU Emacs. diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 920111f2134..764ba979ddd 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2003-2024 Free Software Foundation, Inc. ;; Author: Ulf Jasper -;; Filename: newst-backend.el ;; URL: https://www.nongnu.org/newsticker ;; Keywords: News, RSS, Atom ;; Package: newsticker diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index 6b7050a9ff0..0ff7985f0dc 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2003-2024 Free Software Foundation, Inc. ;; Author: Ulf Jasper -;; Filename: newst-plainview.el ;; URL: https://www.nongnu.org/newsticker ;; Package: newsticker diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el index 130e01a0deb..1638fc877da 100644 --- a/lisp/net/newst-reader.el +++ b/lisp/net/newst-reader.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2003-2024 Free Software Foundation, Inc. ;; Author: Ulf Jasper -;; Filename: newst-reader.el ;; URL: https://www.nongnu.org/newsticker ;; Package: newsticker diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el index cd0ecd4b868..01cd2964778 100644 --- a/lisp/net/newst-ticker.el +++ b/lisp/net/newst-ticker.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2003-2024 Free Software Foundation, Inc. ;; Author: Ulf Jasper -;; Filename: newst-ticker.el ;; URL: https://www.nongnu.org/newsticker ;; Keywords: News, RSS, Atom ;; Package: newsticker diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index 81b6e275ded..89f45ae1049 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2008-2024 Free Software Foundation, Inc. ;; Author: Ulf Jasper -;; Filename: newst-treeview.el ;; Created: 2007 ;; Keywords: News, RSS, Atom ;; Package: newsticker diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el index b34c0268941..6316b8b26ac 100644 --- a/lisp/net/newsticker.el +++ b/lisp/net/newsticker.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2003-2024 Free Software Foundation, Inc. ;; Author: Ulf Jasper -;; Filename: newsticker.el ;; URL: https://www.nongnu.org/newsticker ;; Created: 17. June 2003 ;; Keywords: News, RSS, Atom diff --git a/lisp/use-package/use-package-ensure-system-package.el b/lisp/use-package/use-package-ensure-system-package.el index 6c7f8c0a1ea..9ad2e199913 100644 --- a/lisp/use-package/use-package-ensure-system-package.el +++ b/lisp/use-package/use-package-ensure-system-package.el @@ -6,7 +6,6 @@ ;; Keywords: convenience, tools, extensions ;; URL: https://github.com/waymondo/use-package-ensure-system-package ;; Package-Requires: ((use-package "2.1") (system-packages "1.0.4")) -;; Filename: use-package-ensure-system-package.el ;; This file is part of GNU Emacs. diff --git a/lisp/wdired.el b/lisp/wdired.el index d5d593483dc..be7e39c8957 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -2,7 +2,6 @@ ;; Copyright (C) 2004-2024 Free Software Foundation, Inc. -;; Filename: wdired.el ;; Author: Juan León Lahoz García ;; Old-Version: 2.0 ;; Keywords: dired, environment, files, renaming commit 749ae36ee3e02d41968433915caed6c6fb4cd986 Author: Stefan Kangas Date: Wed Jun 19 07:13:28 2024 +0200 ; * lisp/htmlfontify.el: Remove "Version" header. This package is only distributed with Emacs, so the only relevant version number here is `emacs-version´. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 89c2bee2204..d411b6213c8 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1,11 +1,11 @@ ;;; htmlfontify.el --- htmlize a buffer/source tree with optional hyperlinks -*- lexical-binding: t -*- -;; Copyright (C) 2002-2003, 2009-2024 Free Software Foundation, Inc. +;; Copyright (C) 2002-2024 Free Software Foundation, Inc. ;; Emacs Lisp Archive Entry ;; Package: htmlfontify ;; Filename: htmlfontify.el -;; Version: 0.21 +;; Old-Version: 0.21 ;; Keywords: html, hypermedia, markup, etags ;; Author: Vivek Dasmohapatra ;; Created: 2002-01-05 commit 5fceb53856583384e7adeab52494d1afc6eae666 Author: Po Lu Date: Wed Jun 19 10:57:07 2024 +0800 Avoid races between the tooltip and compositor on X and Android * java/org/gnu/emacs/EmacsView.java (onLayout): Don't send exposure events when the window is still to be attached. * src/androidfns.c (Fx_show_tip): * src/xfns.c (Fx_show_tip): Block async input around initial frame update. diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index 2ea54217837..82792c3fcca 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -425,7 +425,7 @@ else if (child.getVisibility () != GONE) window.viewLayout (left, top, right, bottom); } - if (needExpose) + if (needExpose && isAttachedToWindow) EmacsNative.sendExpose (this.window.handle, 0, 0, right - left, bottom - top); } diff --git a/src/androidfns.c b/src/androidfns.c index 4246f6d2be4..84558350dc0 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -2564,9 +2564,16 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, /* Garbage the tip frame too. */ SET_FRAME_GARBAGED (tip_f); + /* Block input around `update_single_window' and `flush_frame', lest a + ConfigureNotify and Expose event arrive during the update, and set + flags, e.g. garbaged_p, that are cleared once the update completes, + leaving the requested exposure or configuration outstanding. */ + block_input (); w->must_be_updated_p = true; update_single_window (w); flush_frame (tip_f); + unblock_input (); + set_buffer_internal_1 (old_buffer); unbind_to (count_1, Qnil); windows_or_buffers_changed = old_windows_or_buffers_changed; diff --git a/src/xfns.c b/src/xfns.c index c48fa24b6be..4fdcf07e8fb 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -9299,9 +9299,19 @@ Text larger than the specified size is clipped. */) x_cr_update_surface_desired_size (tip_f, width, height); #endif /* USE_CAIRO */ + /* Garbage the tip frame too. */ + SET_FRAME_GARBAGED (tip_f); + + /* Block input around `update_single_window' and `flush_frame', lest a + ConfigureNotify and Expose event arrive during the update, and set + flags, e.g. garbaged_p, that are cleared once the update completes, + leaving the requested exposure or configuration outstanding. */ + block_input (); w->must_be_updated_p = true; update_single_window (w); flush_frame (tip_f); + unblock_input (); + set_buffer_internal_1 (old_buffer); unbind_to (count_1, Qnil); windows_or_buffers_changed = old_windows_or_buffers_changed; commit 94be2b2682bc16b15755dca63ef8406018c9f3e9 Author: Stefan Kangas Date: Tue Jun 18 21:54:22 2024 +0200 ; * .mailmap: Update. diff --git a/.mailmap b/.mailmap index c9bdede6c73..9647749940f 100644 --- a/.mailmap +++ b/.mailmap @@ -97,6 +97,7 @@ Julien Danjou Julien Danjou Juri Linkov Jérémy Compostella Jürgen Hötzel +Justin Burkett Karl Fogel Katsumi Yamaoka Kaushal Modi commit fa4203300fde6820a017bf1089652fb95759d68c Merge: a7dff8c53dd cc0a3a5f65b Author: Philip Kaludercic Date: Tue Jun 18 21:45:58 2024 +0200 Merge remote-tracking branch 'origin/feature/which-key-in-core' commit a7dff8c53dde18c703f470cde9ad033cffe8c766 Author: Stefan Kangas Date: Tue Jun 18 21:27:01 2024 +0200 * lisp/org/ob-lua.el: Minor doc fixes. diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el index 041abfabcd0..980a7109538 100644 --- a/lisp/org/ob-lua.el +++ b/lisp/org/ob-lua.el @@ -23,12 +23,14 @@ ;;; Commentary: -;; Org-Babel support for evaluating lua source code. +;; Org-Babel support for evaluating Lua source code. ;; Requirements: ;; for session support, lua-mode is needed. +;; ;; lua-mode is not part of GNU Emacs/orgmode, but can be obtained -;; from marmalade or melpa. +;; from NonGNU ELPA (see `M-x list-packages'). +;; ;; The source repository is here: ;; https://github.com/immerrr/lua-mode @@ -68,14 +70,14 @@ This will typically be `lua-mode'." :type 'symbol) (defcustom org-babel-lua-hline-to "None" - "Replace hlines in incoming tables with this when translating to lua." + "Replace hlines in incoming tables with this when translating to Lua." :group 'org-babel :version "26.1" :package-version '(Org . "8.3") :type 'string) (defcustom org-babel-lua-None-to 'hline - "Replace `None' in lua tables with this before returning." + "Replace `None' in Lua tables with this before returning." :group 'org-babel :version "26.1" :package-version '(Org . "8.3") @@ -145,8 +147,8 @@ The variable definitions are defining in PARAMS." (org-babel--get-vars params))) (defun org-babel-lua-var-to-lua (var) - "Convert an elisp value to a lua variable. -Convert an elisp value, VAR, into a string of lua source code + "Convert an Emacs Lisp value to a Lua variable. +Convert an Emacs Lisp value, VAR, into a string of Lua source code specifying a variable of the same value." (if (listp var) (if (and (= 1 (length var)) (not (listp (car var)))) @@ -207,7 +209,7 @@ Emacs-lisp table, otherwise return the results as a string." (defvar lua-which-bufname) (defvar lua-shell-buffer-name) (defun org-babel-lua-initiate-session-by-key (&optional session) - "Initiate a lua session. + "Initiate a Lua session. If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." ;; (require org-babel-lua-mode) @@ -317,7 +319,7 @@ PREAMBLE is passed to `org-babel-lua-evaluate-external-process'." "Evaluate BODY in external Lua process. If RESULT-TYPE equals `output' then return standard output as a string. If RESULT-TYPE equals `value' then return the value of the -last statement in BODY, as elisp. +last statement in BODY, as Emacs Lisp. RESULT-PARAMS list all the :result header arg parameters. PREAMBLE string is appended to BODY." (let ((raw @@ -353,7 +355,7 @@ PREAMBLE string is appended to BODY." "Pass BODY to the Lua process in SESSION. If RESULT-TYPE equals `output' then return standard output as a string. If RESULT-TYPE equals `value' then return the value of the -last statement in BODY, as elisp." +last statement in BODY, as Emacs Lisp." (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0.005))) (dump-last-value (lambda commit 0d1edecf1eaab277465b77e8627de01599cc7cee Author: Stefan Kangas Date: Tue Jun 18 21:10:42 2024 +0200 Update Coccinelle URL * admin/coccinelle/README: Update URL. diff --git a/admin/coccinelle/README b/admin/coccinelle/README index 48a88dbc8d8..0e7bd9dd946 100644 --- a/admin/coccinelle/README +++ b/admin/coccinelle/README @@ -1,3 +1,5 @@ This directory contains semantic patches for Coccinelle, a program matching -and transformation tool for programs written in C. For more details, see -http://coccinelle.lip6.fr. +and transformation tool for programs written in C. + +For more information, see: +https://coccinelle.gitlabpages.inria.fr/website commit dceb28a1cfad276cdf070a9b2ca4d8f3ab3c1a85 Author: Jonas Bernoulli Date: Tue Jun 18 17:02:20 2024 +0200 Update to Transient v0.7.0-1-g482bc777 diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index 0aa520237f7..7e8ffcf91bf 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -31,7 +31,7 @@ General Public License for more details. @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.6.0 +@subtitle for version 0.7.0 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial, available at @uref{https://github.com/positron-solutions/transient-showcase}. @noindent -This manual is for Transient version 0.6.0. +This manual is for Transient version 0.7.0. @insertcopying @end ifnottex @@ -1112,7 +1112,8 @@ Transients}) and adds the transient's infix and suffix bindings, as described below. Users and third-party packages can add additional bindings using -functions such as @code{transient-insert-suffix} (@pxref{Modifying Existing Transients}). These functions take a ``suffix specification'' as one of +functions such as @code{transient-insert-suffix} (@pxref{Modifying Existing Transients}). +These functions take a ``suffix specification'' as one of their arguments, which has the same form as the specifications used in @code{transient-define-prefix}. @@ -1380,16 +1381,12 @@ This macro defines @var{NAME} as a transient infix command. reserved for future use. @var{DOCSTRING} is the documentation string and is optional. -The keyword-value pairs are mandatory. All transient infix commands -are @code{equal} to each other (but not @code{eq}), so it is meaningless to define -an infix command without also setting at least @code{:class} and one other -keyword (which it is depends on the used class, usually @code{:argument} or -@code{:variable}). - -Each keyword has to be a keyword symbol, either @code{:class} or a keyword -argument supported by the constructor of that class. The -@code{transient-switch} class is used if the class is not specified -explicitly. +At least one key-value pair is required. All transient infix +commands are @code{equal} to each other (but not @code{eq}). It is meaningless +to define an infix command, without providing at least one keyword +argument (usually @code{:argument} or @code{:variable}, depending on the class). +The suffix class defaults to @code{transient-switch} and can be set using +the @code{:class} keyword. The function definition is always: @@ -2372,6 +2369,20 @@ the transient popup, you will be able to yank it in another buffer. #'transient--do-stay) @end lisp +@anchor{How can I autoload prefix and suffix commands?} +@appendixsec How can I autoload prefix and suffix commands? + +If your package only supports Emacs 30, just prefix the definition +with @code{;;;###autoload}. If your package supports released versions of +Emacs, you unfortunately have to use a long form autoload comment +as described in @ref{Autoload,,,elisp,}. + +@lisp +;;;###autoload (autoload 'magit-dispatch "magit" nil t) +(transient-define-prefix magit-dispatch () + ...) +@end lisp + @anchor{How does Transient compare to prefix keys and universal arguments?} @appendixsec How does Transient compare to prefix keys and universal arguments? diff --git a/lisp/transient.el b/lisp/transient.el index c9b6e457d00..34458bec688 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -5,7 +5,7 @@ ;; Author: Jonas Bernoulli ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Version: 0.6.0 +;; Version: 0.7.0 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -38,7 +38,7 @@ (require 'format-spec) (eval-and-compile - (when (and (featurep' seq) + (when (and (featurep 'seq) (not (fboundp 'seq-keep))) (unload-feature 'seq 'force))) (require 'seq) @@ -721,24 +721,12 @@ the prototype is stored in the clone's `prototype' slot.") (if-not-derived :initarg :if-not-derived :initform nil - :documentation "Enable if major-mode does not derive from value.")) - "Abstract superclass for group and suffix classes. - -It is undefined what happens if more than one `if*' predicate -slot is non-nil." - :abstract t) - -(defclass transient-suffix (transient-child) - ((definition :allocation :class :initform nil) - (key :initarg :key) - (command :initarg :command) - (transient :initarg :transient) - (format :initarg :format :initform " %k %d") - (description :initarg :description :initform nil) - (face :initarg :face :initform nil) - (show-help :initarg :show-help :initform nil) - (inapt-face :initarg :inapt-face :initform 'transient-inapt-suffix) - (inapt :initform nil) + :documentation "Enable if major-mode does not derive from value.") + (inapt + :initform nil) + (inapt-face + :initarg :inapt-face + :initform 'transient-inapt-suffix) (inapt-if :initarg :inapt-if :initform nil @@ -771,13 +759,33 @@ slot is non-nil." :initarg :inapt-if-not-derived :initform nil :documentation "Inapt if major-mode does not derive from value.")) + "Abstract superclass for group and suffix classes. + +It is undefined what happens if more than one `if*' predicate +slot is non-nil." + :abstract t) + +(defclass transient-suffix (transient-child) + ((definition :allocation :class :initform nil) + (key :initarg :key) + (command :initarg :command) + (transient :initarg :transient) + (format :initarg :format :initform " %k %d") + (description :initarg :description :initform nil) + (face :initarg :face :initform nil) + (show-help :initarg :show-help :initform nil)) "Superclass for suffix command.") (defclass transient-information (transient-suffix) ((format :initform " %k %d") (key :initform " ")) - "Display-only information. -A suffix object with no associated command.") + "Display-only information, aligned with suffix keys. +Technically a suffix object with no associated command.") + +(defclass transient-information* (transient-information) + ((format :initform " %d")) + "Display-only information, aligned with suffix descriptions. +Technically a suffix object with no associated command.") (defclass transient-infix (transient-suffix) ((transient :initform t) @@ -834,6 +842,7 @@ They become the value of this argument.") (hide :initarg :hide :initform nil) (description :initarg :description :initform nil) (pad-keys :initarg :pad-keys :initform nil) + (info-format :initarg :info-format :initform nil) (setup-children :initarg :setup-children)) "Abstract superclass of all group classes." :abstract t) @@ -907,8 +916,9 @@ to the setup function: [&optional ("interactive" interactive) def-body])) (indent defun) (doc-string 3)) - (pcase-let ((`(,class ,slots ,suffixes ,docstr ,body) - (transient--expand-define-args args arglist))) + (pcase-let + ((`(,class ,slots ,suffixes ,docstr ,body ,interactive-only) + (transient--expand-define-args args arglist 'transient-define-prefix))) `(progn (defalias ',name ,(if body @@ -916,7 +926,7 @@ to the setup function: `(lambda () (interactive) (transient-setup ',name)))) - (put ',name 'interactive-only t) + (put ',name 'interactive-only ,interactive-only) (put ',name 'function-documentation ,docstr) (put ',name 'transient--prefix (,(or class 'transient-prefix) :command ',name ,@slots)) @@ -940,42 +950,50 @@ The BODY must begin with an `interactive' form that matches ARGLIST. The infix arguments are usually accessed by using `transient-args' inside `interactive'. -\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... BODY...)" +\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... [BODY...])" (declare (debug ( &define name lambda-list [&optional lambda-doc] [&rest keywordp sexp] - ("interactive" interactive) - def-body)) + [&optional ("interactive" interactive) def-body])) (indent defun) (doc-string 3)) - (pcase-let ((`(,class ,slots ,_ ,docstr ,body) - (transient--expand-define-args args arglist))) + (pcase-let + ((`(,class ,slots ,_ ,docstr ,body ,interactive-only) + (transient--expand-define-args args arglist 'transient-define-suffix))) `(progn (defalias ',name ,(if (and (not body) class (oref-default class definition)) `(oref-default ',class definition) `(lambda ,arglist ,@body))) - (put ',name 'interactive-only t) + (put ',name 'interactive-only ,interactive-only) (put ',name 'function-documentation ,docstr) (put ',name 'transient--suffix (,(or class 'transient-suffix) :command ',name ,@slots))))) +(defmacro transient-augment-suffix (name &rest args) + "Augment existing command NAME with a new transient suffix object. +Similar to `transient-define-suffix' but define a suffix object only. +\n\(fn NAME [KEYWORD VALUE]...)" + (declare (debug (&define name [&rest keywordp sexp])) + (indent defun)) + (pcase-let + ((`(,class ,slots) + (transient--expand-define-args args nil 'transient-augment-suffix t))) + `(put ',name 'transient--suffix + (,(or class 'transient-suffix) :command ',name ,@slots)))) + (defmacro transient-define-infix (name arglist &rest args) "Define NAME as a transient infix command. ARGLIST is always ignored and reserved for future use. DOCSTRING is the documentation string and is optional. -The key-value pairs are mandatory. All transient infix commands -are equal to each other (but not eq), so it is meaningless to -define an infix command without also setting at least `:class' -and one other keyword (which it is depends on the used class, -usually `:argument' or `:variable'). - -Each key has to be a keyword symbol, either `:class' or a keyword -argument supported by the constructor of that class. The -`transient-switch' class is used if the class is not specified -explicitly. +At least one key-value pair is required. All transient infix +commands are equal to each other (but not eq). It is meaning- +less to define an infix command, without providing at least one +keyword argument (usually `:argument' or `:variable', depending +on the class). The suffix class defaults to `transient-switch' +and can be set using the `:class' keyword. The function definitions is always: @@ -994,17 +1012,19 @@ that case you have to use `transient-define-suffix' to define the infix command and use t as the value of the `:transient' keyword. -\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)" +\(fn NAME ARGLIST [DOCSTRING] KEYWORD VALUE [KEYWORD VALUE]...)" (declare (debug ( &define name lambda-list [&optional lambda-doc] + keywordp sexp [&rest keywordp sexp])) (indent defun) (doc-string 3)) - (pcase-let ((`(,class ,slots ,_ ,docstr ,_) - (transient--expand-define-args args arglist))) + (pcase-let + ((`(,class ,slots ,_ ,docstr ,_ ,interactive-only) + (transient--expand-define-args args arglist 'transient-define-infix t))) `(progn (defalias ',name #'transient--default-infix-command) - (put ',name 'interactive-only t) + (put ',name 'interactive-only ,interactive-only) (put ',name 'completion-predicate #'transient--suffix-only) (put ',name 'function-documentation ,docstr) (put ',name 'transient--suffix @@ -1044,7 +1064,8 @@ falling back to that of the same aliased command." (put 'transient--default-infix-command 'completion-predicate #'transient--suffix-only) -(defun transient--find-function-advised-original (fn func) +(define-advice find-function-advised-original + (:around (fn func) transient-default-infix) "Return nil instead of `transient--default-infix-command'. When using `find-function' to jump to the definition of a transient infix command/argument, then we want to actually jump to that, not to @@ -1052,14 +1073,12 @@ the definition of `transient--default-infix-command', which all infix commands are aliases for." (let ((val (funcall fn func))) (and val (not (eq val 'transient--default-infix-command)) val))) -(advice-add 'find-function-advised-original :around - #'transient--find-function-advised-original) -(eval-and-compile - (defun transient--expand-define-args (args &optional arglist) +(eval-and-compile ;transient--expand-define-args + (defun transient--expand-define-args (args arglist form &optional nobody) (unless (listp arglist) (error "Mandatory ARGLIST is missing")) - (let (class keys suffixes docstr) + (let (class keys suffixes docstr declare (interactive-only t)) (when (stringp (car args)) (setq docstr (pop args))) (while (keywordp (car args)) @@ -1073,13 +1092,28 @@ commands are aliases for." (or (vectorp arg) (and arg (symbolp arg)))) (push (pop args) suffixes)) + (when (eq (car-safe (car args)) 'declare) + (setq declare (car args)) + (setq args (cdr args)) + (when-let ((int (assq 'interactive-only declare))) + (setq interactive-only (cadr int)) + (delq int declare)) + (unless (cdr declare) + (setq declare nil))) + (cond + ((not args)) + (nobody + (error "%s: No function body allowed" form)) + ((not (eq (car-safe (nth (if declare 1 0) args)) 'interactive)) + (error "%s: Interactive form missing" form))) (list (if (eq (car-safe class) 'quote) (cadr class) class) (nreverse keys) (nreverse suffixes) docstr - args)))) + (if declare (cons declare args) args) + interactive-only)))) (defun transient--parse-child (prefix spec) (cl-typecase spec @@ -1150,9 +1184,9 @@ commands are aliases for." (commandp (cadr spec))) (setq args (plist-put args :description (macroexp-quote pop))))) (cond - ((eq car :info)) + ((memq car '(:info :info*))) ((keywordp car) - (error "Need command or `:info', got `%s'" car)) + (error "Need command, `:info' or `:info*', got `%s'" car)) ((symbolp car) (setq args (plist-put args :command (macroexp-quote pop)))) ((and (commandp car) @@ -1212,6 +1246,9 @@ commands are aliases for." ((eq key :info) (setq class 'transient-information) (setq args (plist-put args :description val))) + ((eq key :info*) + (setq class 'transient-information*) + (setq args (plist-put args :description val))) ((eq (car-safe val) '\,) (setq args (plist-put args key (cadr val)))) ((or (symbolp val) @@ -1479,6 +1516,10 @@ variable instead.") (defvar transient-exit-hook nil "Hook run after exiting a transient.") +(defvar transient-setup-buffer-hook nil + "Hook run when setting up the transient buffer. +That buffer is current and empty when this hook runs.") + (defvar transient--prefix nil) (defvar transient--layout nil) (defvar transient--suffixes nil) @@ -1506,6 +1547,9 @@ variable instead.") (defvar transient--buffer-name " *transient*" "Name of the transient buffer.") +(defvar transient--buffer nil + "The transient menu buffer.") + (defvar transient--window nil "The window used to display the transient popup buffer.") @@ -1859,15 +1903,20 @@ of the corresponding object." (setq key (save-match-data (funcall transient-substitute-key-function obj))) (oset obj key key)) - (let ((kbd (kbd key)) - (cmd (oref obj command))) - (when-let ((conflict (and transient-detect-key-conflicts - (transient--lookup-key map kbd)))) - (unless (eq cmd conflict) - (error "Cannot bind %S to %s and also %s" - (string-trim key) - cmd conflict))) - (define-key map kbd cmd)))) + (let* ((kbd (kbd key)) + (cmd (oref obj command)) + (alt (transient--lookup-key map kbd))) + (cond ((not alt) + (define-key map kbd cmd)) + ((eq alt cmd)) + ((transient--inapt-suffix-p obj)) + ((and-let* ((obj (transient-suffix-object alt))) + (transient--inapt-suffix-p obj)) + (define-key map kbd cmd)) + (transient-detect-key-conflicts + (error "Cannot bind %S to %s and also %s" + (string-trim key) cmd alt)) + ((define-key map kbd cmd)))))) (when-let ((b (keymap-lookup map "-"))) (keymap-set map "" b)) (when-let ((b (keymap-lookup map "="))) (keymap-set map "" b)) (when-let ((b (keymap-lookup map "+"))) (keymap-set map "" b)) @@ -2039,7 +2088,7 @@ value. Otherwise return CHILDREN as is." (defun transient--init-suffixes (name) (let ((levels (alist-get name transient-levels))) - (cl-mapcan (lambda (c) (transient--init-child levels c)) + (cl-mapcan (lambda (c) (transient--init-child levels c nil)) (append (get name 'transient--layout) (and (not transient--editp) (get 'transient-common-commands @@ -2057,24 +2106,29 @@ value. Otherwise return CHILDREN as is." (list def))))) (cl-mapcan #'s layout))) -(defun transient--init-child (levels spec) +(defun transient--init-child (levels spec parent) (cl-etypecase spec - (vector (transient--init-group levels spec)) - (list (transient--init-suffix levels spec)) + (vector (transient--init-group levels spec parent)) + (list (transient--init-suffix levels spec parent)) (string (list spec)))) -(defun transient--init-group (levels spec) +(defun transient--init-group (levels spec parent) (pcase-let ((`(,level ,class ,args ,children) (append spec nil))) - (and-let* ((- (transient--use-level-p level)) + (and-let* (((transient--use-level-p level)) (obj (apply class :level level args)) - (- (transient--use-suffix-p obj)) - (suffixes (cl-mapcan (lambda (c) (transient--init-child levels c)) - (transient-setup-children obj children)))) + ((transient--use-suffix-p obj)) + ((prog1 t + (when (or (and parent (oref parent inapt)) + (transient--inapt-suffix-p obj)) + (oset obj inapt t)))) + (suffixes (cl-mapcan + (lambda (c) (transient--init-child levels c obj)) + (transient-setup-children obj children)))) (progn ; work around debbugs#31840 (oset obj suffixes suffixes) (list obj))))) -(defun transient--init-suffix (levels spec) +(defun transient--init-suffix (levels spec parent) (pcase-let* ((`(,level ,class ,args) spec) (cmd (plist-get args :command)) (key (transient--kbd (plist-get args :key))) @@ -2107,7 +2161,8 @@ value. Otherwise return CHILDREN as is." (unless (cl-typep obj 'transient-information) (transient--init-suffix-key obj)) (when (transient--use-suffix-p obj) - (if (transient--inapt-suffix-p obj) + (if (or (and parent (oref parent inapt)) + (transient--inapt-suffix-p obj)) (oset obj inapt t) (transient-init-scope obj) (transient-init-value obj)) @@ -2296,8 +2351,9 @@ value. Otherwise return CHILDREN as is." 'other) (with-demoted-errors "Error while exiting transient: %S" (delete-window transient--window))) - (when-let ((buffer (get-buffer transient--buffer-name))) - (kill-buffer buffer)) + (when (buffer-live-p transient--buffer) + (kill-buffer transient--buffer)) + (setq transient--buffer nil) (when remain-in-minibuffer-window (select-window remain-in-minibuffer-window))))) @@ -2468,7 +2524,7 @@ value. Otherwise return CHILDREN as is." ;; We cannot use `current-prefix-arg' because it is set ;; too late (in `command-execute'), and if it were set ;; earlier, then we likely still would not be able to - ;; rely on it and `prefix-command-preserve-state-hook' + ;; rely on it, and `prefix-command-preserve-state-hook' ;; would have to be used to record that a universal ;; argument is in effect. (not prefix-arg))) @@ -2546,8 +2602,7 @@ value. Otherwise return CHILDREN as is." mouse-set-region)) (equal (key-description (this-command-keys-vector)) "")) - (and (eq (current-buffer) - (get-buffer transient--buffer-name))))) + (and (eq (current-buffer) transient--buffer)))) (transient--show)) (when (and (numberp transient-show-popup) (not (zerop transient-show-popup)) @@ -2575,11 +2630,12 @@ value. Otherwise return CHILDREN as is." (if (symbolp arg) (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)" arg - (if (fboundp 'help-fns-function-name) - (help-fns-function-name this-command) - (if (byte-code-function-p this-command) - "#[...]" - this-command)) + (cond ((and (symbolp this-command) this-command)) + ((fboundp 'help-fns-function-name) + (help-fns-function-name this-command)) + ((byte-code-function-p this-command) + "#[...]") + (this-command)) (key-description (this-command-keys-vector)) transient--exitp (cond ((keywordp (car args)) @@ -3357,7 +3413,7 @@ prompt." (cl-defmethod transient-infix-set :after ((obj transient-argument) value) "Unset incompatible infix arguments." - (when-let* ((--- value) + (when-let* ((value) (val (transient-infix-value obj)) (arg (if (slot-boundp obj 'argument) (oref obj argument) @@ -3371,15 +3427,15 @@ prompt." (and (not (equal val arg)) (cl-mapcan (apply-partially filter val) spec))))) (dolist (obj transient--suffixes) - (when-let* ((--- (cl-typep obj 'transient-argument)) + (when-let* (((cl-typep obj 'transient-argument)) (val (transient-infix-value obj)) (arg (if (slot-boundp obj 'argument) (oref obj argument) (oref obj argument-format))) - (--- (if (equal val arg) - (member arg incomp) - (or (member val incomp) - (member arg incomp))))) + ((if (equal val arg) + (member arg incomp) + (or (member val incomp) + (member arg incomp))))) (transient-infix-set obj nil))))) (cl-defgeneric transient-set-value (obj) @@ -3515,6 +3571,10 @@ the option does not appear in ARGS." (or (match-string 1 match) ""))) (and (member arg args) t))) +(defun transient-scope () + "Return the value of the `scope' slot of the current prefix." + (oref (transient-prefix-object) scope)) + ;;; History (cl-defgeneric transient--history-key (obj) @@ -3580,15 +3640,18 @@ have a history of their own.") (transient--timer-cancel) (setq transient--showp t) (let ((transient--shadowed-buffer (current-buffer)) - (buf (get-buffer-create transient--buffer-name)) (focus nil)) - (with-current-buffer buf + (setq transient--buffer (get-buffer-create transient--buffer-name)) + (with-current-buffer transient--buffer (when transient-enable-popup-navigation (setq focus (or (button-get (point) 'command) (and (not (bobp)) (button-get (1- (point)) 'command)) (transient--heading-at-point)))) (erase-buffer) + (run-hooks 'transient-setup-buffer-hook) + (when transient-force-fixed-pitch + (transient--force-fixed-pitch)) (setq window-size-fixed t) (when (bound-and-true-p tab-line-format) (setq tab-line-format nil)) @@ -3609,12 +3672,11 @@ have a history of their own.") (when (or transient--helpp transient--editp) (transient--insert-help)) (when-let ((line (transient--separator-line))) - (insert line)) - (when transient-force-fixed-pitch - (transient--force-fixed-pitch))) + (insert line))) (unless (window-live-p transient--window) (setq transient--window - (display-buffer buf transient-display-buffer-action))) + (display-buffer transient--buffer + transient-display-buffer-action))) (when (window-live-p transient--window) (with-selected-window transient--window (goto-char (point-min)) @@ -3657,9 +3719,8 @@ have a history of their own.") (transient-with-shadowed-buffer (funcall hide)))) (list group)))) - transient--layout)) - group) - (while (setq group (pop groups)) + transient--layout))) + (while-let ((group (pop groups))) (transient--insert-group group) (when groups (insert ?\n))))) @@ -3702,9 +3763,9 @@ have a history of their own.") (transient-with-shadowed-buffer (let* ((transient--pending-group column) (rows (mapcar #'transient-format (oref column suffixes)))) - (when-let ((desc (transient-format-description column))) - (push desc rows)) - (flatten-tree rows)))) + (if-let ((desc (transient-format-description column))) + (cons desc rows) + rows)))) (oref group suffixes))) (vp (or (oref transient--prefix variable-pitch) transient-align-variable-pitch)) @@ -3721,7 +3782,7 @@ have a history of their own.") col)))) columns)) (cc (transient--seq-reductions-from - (apply-partially #'+ (* 3 (if vp (transient--pixel-width " ") 1))) + (apply-partially #'+ (* 2 (if vp (transient--pixel-width " ") 1))) cw 0))) (if transient-force-single-column (dotimes (c cs) @@ -3750,14 +3811,12 @@ have a history of their own.") (insert ?\n)))))))) (cl-defmethod transient--insert-group ((group transient-subgroups)) - (let* ((subgroups (oref group suffixes)) - (n (length subgroups))) - (dotimes (s n) - (let ((subgroup (nth s subgroups))) - (transient--maybe-pad-keys subgroup group) - (transient--insert-group subgroup) - (when (< s (1- n)) - (insert ?\n)))))) + (let ((subgroups (oref group suffixes))) + (while-let ((subgroup (pop subgroups))) + (transient--maybe-pad-keys subgroup group) + (transient--insert-group subgroup) + (when subgroups + (insert ?\n))))) (cl-defgeneric transient-format (obj) "Format and return OBJ for display. @@ -3889,28 +3948,22 @@ as a button." (cl-defgeneric transient-format-description (obj) "Format OBJ's `description' for display and return the result.") -(cl-defmethod transient-format-description ((obj transient-child)) +(cl-defmethod transient-format-description ((obj transient-suffix)) "The `description' slot may be a function, in which case that is called inside the correct buffer (see `transient--insert-group') and its value is returned to the caller." - (and-let* ((desc (oref obj description)) - (desc (if (functionp desc) - (if (= (car (func-arity desc)) 1) - (funcall desc obj) - (funcall desc)) - desc))) - (if-let* ((face (transient--get-face obj 'face))) - (transient--add-face desc face t) - desc))) + (transient--get-description obj)) (cl-defmethod transient-format-description ((obj transient-group)) "Format the description by calling the next method. If the result doesn't use the `face' property at all, then apply the face `transient-heading' to the complete string." - (and-let* ((desc (cl-call-next-method obj))) - (if (text-property-not-all 0 (length desc) 'face nil desc) - desc - (propertize desc 'face 'transient-heading)))) + (and-let* ((desc (transient--get-description obj))) + (cond ((oref obj inapt) + (propertize desc 'face 'transient-inapt-suffix)) + ((text-property-not-all 0 (length desc) 'face nil desc) + desc) + ((propertize desc 'face 'transient-heading))))) (cl-defmethod transient-format-description :around ((obj transient-suffix)) "Format the description by calling the next method. If the result @@ -3920,8 +3973,11 @@ If the OBJ's `key' is currently unreachable, then apply the face (let ((desc (or (cl-call-next-method obj) (and (slot-boundp transient--prefix 'suffix-description) (funcall (oref transient--prefix suffix-description) - obj)) - (propertize "(BUG: no description)" 'face 'error)))) + obj))))) + (if desc + (when-let ((face (transient--get-face obj 'face))) + (setq desc (transient--add-face desc face t))) + (setq desc (propertize "(BUG: no description)" 'face 'error))) (when (if transient--all-levels-p (> (oref obj level) transient--default-prefix-level) (and transient-highlight-higher-levels @@ -3983,23 +4039,30 @@ If the OBJ's `key' is currently unreachable, then apply the face choices (propertize "|" 'face 'transient-delimiter)))))) -(defun transient--add-face (string face &optional append beg end) - (let ((str (copy-sequence string))) - (add-face-text-property (or beg 0) (or end (length str)) face append str) - str)) +(cl-defmethod transient--get-description ((obj transient-child)) + (and-let* ((desc (oref obj description))) + (if (functionp desc) + (if (= (car (transient--func-arity desc)) 1) + (funcall desc obj) + (funcall desc)) + desc))) -(defun transient--get-face (obj slot) - (and-let* ((! (slot-exists-p obj slot)) - (! (slot-boundp obj slot)) +(cl-defmethod transient--get-face ((obj transient-suffix) slot) + (and-let* (((slot-boundp obj slot)) (face (slot-value obj slot))) (if (and (not (facep face)) (functionp face)) (let ((transient--pending-suffix obj)) - (if (= (car (func-arity face)) 1) + (if (= (car (transient--func-arity face)) 1) (funcall face obj) (funcall face))) face))) +(defun transient--add-face (string face &optional append beg end) + (let ((str (copy-sequence string))) + (add-face-text-property (or beg 0) (or end (length str)) face append str) + str)) + (defun transient--key-face (&optional cmd enforce-type) (or (and transient-semantic-coloring (not transient--helpp) @@ -4025,12 +4088,13 @@ If the OBJ's `key' is currently unreachable, then apply the face (when-let ((pad (or (oref group pad-keys) (and parent (oref parent pad-keys))))) (oset group pad-keys - (apply #'max (cons (if (integerp pad) pad 0) - (seq-keep (lambda (suffix) - (and (eieio-object-p suffix) - (slot-boundp suffix 'key) - (length (oref suffix key)))) - (oref group suffixes))))))) + (apply #'max + (if (integerp pad) pad 0) + (seq-keep (lambda (suffix) + (and (eieio-object-p suffix) + (slot-boundp suffix 'key) + (length (oref suffix key)))) + (oref group suffixes)))))) (defun transient--pixel-width (string) (save-window-excursion @@ -4386,7 +4450,8 @@ we stop there." (face-remap-reset-base 'default) (face-remap-add-relative 'default 'fixed-pitch)) -;;;; Missing from Emacs +(defun transient--func-arity (fn) + (func-arity (advice--cd*r (if (symbolp fn) (symbol-function fn) fn)))) (defun transient--seq-reductions-from (function sequence initial-value) (let ((acc (list initial-value))) @@ -4394,18 +4459,6 @@ we stop there." (push (funcall function (car acc) elt) acc)) (nreverse acc))) -(defun transient-plist-to-alist (plist) - (let (alist) - (while plist - (push (cons (let* ((symbol (pop plist)) - (name (symbol-name symbol))) - (if (eq (aref name 0) ?:) - (intern (substring name 1)) - symbol)) - (pop plist)) - alist)) - (nreverse alist))) - ;;; Font-Lock (defconst transient-font-lock-keywords commit dc308348a904d69916ca6ab1eb587aff03e8421c Author: Michael Albinus Date: Tue Jun 18 14:40:20 2024 +0200 Adapt tramp-use-file-attributes * doc/misc/tramp.texi: Fix indentation. (Bug Reports): Mention Gmane group gmane.emacs.tramp. (Frequently Asked Questions): Precise tramp-use-file-attributes entry. * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): Dump os-release when `tramp-verbose' is at least 9. * lisp/net/tramp.el (tramp-use-file-attributes): Adapt docstring. Use connection-local value. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index dc119e87849..ef74f1e3f13 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2420,24 +2420,26 @@ You could define your own search directories like this: @lisp @group -(connection-local-set-profile-variables 'remote-path-with-bin - '((tramp-remote-path . ("~/bin" tramp-default-remote-path)))) +(connection-local-set-profile-variables + 'remote-path-with-bin + '((tramp-remote-path . ("~/bin" tramp-default-remote-path)))) @end group @group -(connection-local-set-profile-variables 'remote-path-with-apply-pub-bin - '((tramp-remote-path . ("/appli/pub/bin" tramp-default-remote-path)))) +(connection-local-set-profile-variables + 'remote-path-with-apply-pub-bin + '((tramp-remote-path . ("/appli/pub/bin" tramp-default-remote-path)))) @end group @group (connection-local-set-profiles - '(:application tramp :machine "randomhost") 'remote-path-with-bin) + '(:application tramp :machine "randomhost") 'remote-path-with-bin) @end group @group (connection-local-set-profiles - '(:application tramp :user "anotheruser" :machine "anotherhost") - 'remote-path-with-apply-pub-bin) + '(:application tramp :user "anotheruser" :machine "anotherhost") + 'remote-path-with-apply-pub-bin) @end group @end lisp @@ -2554,18 +2556,18 @@ example below: @group (customize-set-variable 'tramp-password-prompt-regexp - (concat - "^.*" - (regexp-opt - '("passphrase" "Passphrase" - ;; English - "password" "Password" - ;; Deutsch - "passwort" "Passwort" - ;; Français - "mot de passe" "Mot de passe") - t) - ".*:\0? *")) + (concat + "^.*" + (regexp-opt + '("passphrase" "Passphrase" + ;; English + "password" "Password" + ;; Deutsch + "passwort" "Passwort" + ;; Français + "mot de passe" "Mot de passe") + t) + ".*:\0? *")) @end group @end lisp @@ -2872,8 +2874,8 @@ allows you to set the @option{ControlPath} provided the variable (customize-set-variable 'tramp-ssh-controlmaster-options (concat - "-o ControlPath=/tmp/ssh-ControlPath-%%r@@%%h:%%p " - "-o ControlMaster=auto -o ControlPersist=yes")) + "-o ControlPath=/tmp/ssh-ControlPath-%%r@@%%h:%%p " + "-o ControlMaster=auto -o ControlPersist=yes")) @end group @end lisp @@ -4155,29 +4157,29 @@ of @code{explicit-shell-file-name} for different remote hosts. @lisp @group (connection-local-set-profile-variables - 'remote-bash - '((explicit-shell-file-name . "/bin/bash") - (explicit-bash-args . ("-i")))) + 'remote-bash + '((explicit-shell-file-name . "/bin/bash") + (explicit-bash-args . ("-i")))) @end group @group (connection-local-set-profile-variables - 'remote-ksh - '((explicit-shell-file-name . "/bin/ksh") - (explicit-ksh-args . ("-i")))) + 'remote-ksh + '((explicit-shell-file-name . "/bin/ksh") + (explicit-ksh-args . ("-i")))) @end group @group (connection-local-set-profiles - '(:application tramp :protocol "ssh" :machine "localhost") - 'remote-bash) + '(:application tramp :protocol "ssh" :machine "localhost") + 'remote-bash) @end group @group (connection-local-set-profiles - `(:application tramp :protocol "sudo" - :user "root" :machine ,(system-name)) - 'remote-ksh) + `(:application tramp :protocol "sudo" + :user "root" :machine ,(system-name)) + 'remote-ksh) @end group @end lisp @@ -4536,8 +4538,8 @@ which must be set to a non-@code{nil} value. Example: @lisp @group (connection-local-set-profile-variables - 'remote-direct-async-process - '((tramp-direct-async-process . t))) + 'remote-direct-async-process + '((tramp-direct-async-process . t))) @end group @group @@ -5047,6 +5049,9 @@ To subscribe to the mailing list, visit: @uref{https://lists.gnu.org/mailman/listinfo/tramp-devel/, the @value{tramp} Mail Subscription Page}. +There is also a @acronym{Gmane} group, mirroring the mailing list. +Its name is @samp{gmane.emacs.tramp}. + @ifset installchapter Before sending a bug report, run the test suite first @ref{Testing}. @end ifset @@ -5222,8 +5227,8 @@ connections, apply the following code. @lisp @group (connection-local-set-profile-variables - 'my-auto-save-profile - '((buffer-auto-save-file-name . nil))) + 'my-auto-save-profile + '((buffer-auto-save-file-name . nil))) @end group @group @@ -5519,8 +5524,8 @@ Since @w{Emacs 30}, these options can be set connection-local. @lisp @group (connection-local-set-profile-variables - 'my-dired-profile - '((dired-listing-switches . "-ahl"))) + 'my-dired-profile + '((dired-listing-switches . "-ahl"))) @end group @group @@ -5552,10 +5557,26 @@ readable @vindex tramp-use-file-attributes Internally, @value{tramp} uses commands like @command{ls} or -@command{stat} in order to determine file permissions. On some file -systems, like @acronym{GPFS}, they don't report proper information. -Set the user option @code{tramp-use-file-attributes} to @code{nil} in -such a case. +@command{stat} in order to determine file permissions. When +@acronym{NFS4_ACL} is enabled on the remote host, more fine-grained +information is used which cannot be reflected by the permission string +returned from those commands. Set the user option +@code{tramp-use-file-attributes} to @code{nil} in such a case. This +can also be set host-wise, like in: + +@lisp +@group +(connection-local-set-profile-variables + 'my-file-attributes-profile + '((tramp-use-file-attributes . nil))) +@end group + +@group +(connection-local-set-profiles + '(:application tramp :machine "remotehost") + 'my-file-attributes-profile) +@end group +@end lisp @item diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 02be2ed4b7f..bce7c323dad 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4455,6 +4455,12 @@ process to set up. VEC specifies the connection." (tramp-cleanup-connection vec t t) (throw 'uname-changed (tramp-maybe-open-connection vec))) + ;; Dump /etc/os-release in the traces. + (when (>= tramp-verbose 9) + (tramp-send-command + vec (format "cat /etc/os-release 2>%s" (tramp-get-remote-null-device vec)) + t)) + ;; Try to set up the coding system correctly. ;; CCC this can't be the right way to do it. Hm. (tramp-message vec 5 "Determining coding system") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ee7fa59ad21..d9db17ea598 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3446,15 +3446,18 @@ BODY is the backend specific code." (defcustom tramp-use-file-attributes t "Whether to use \"file-attributes\" file property for check. -This is relevant for `file-directory-p', `file-executable-p', -`file-exists-p', and `file-readable-p'. On some file systems, like -GPFS, the permission string is not trustworthy." +This is relevant for read, write, and execute permissions. On some file +systems using NFS4_ACL, the permission string as returned from `stat' or +`ls', is not sufficient to provide more fine-grained information. +This variable is intended as connection-local variable." :version "30.1" :type 'boolean) (defsubst tramp-use-file-attributes (vec) "Whether to use \"file-attributes\" file property for check." - (and tramp-use-file-attributes + (and ;; We assume, that connection-local variables are set in this buffer. + (with-current-buffer (tramp-get-connection-buffer vec) + tramp-use-file-attributes) (tramp-file-property-p vec (tramp-file-name-localname vec) "file-attributes"))) commit cc0a3a5f65bda4d3a34cfcd8070540aa1b36f84d (refs/remotes/origin/feature/which-key-in-core) Author: Philip Kaludercic Date: Tue Jun 18 10:53:18 2024 +0200 Disable usage of unicode for which-key by default * lisp/which-key.el (which-key-dont-use-unicode): Set to t. (which-key-separator, which-key-ellipsis): Ensure that these options are set after 'which-key-dont-use-unicode', as their default value depends on it. diff --git a/lisp/which-key.el b/lisp/which-key.el index 45f8a31364a..1de599e5497 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -124,7 +124,7 @@ of the which-key popup." :type 'integer :package-version "1.0" :version "30.1") -(defcustom which-key-dont-use-unicode nil +(defcustom which-key-dont-use-unicode t "If non-nil, don't use any unicode characters in default setup. For affected settings, see `which-key-replacement-alist', `which-key-ellipsis' `which-key-separator'." @@ -137,6 +137,7 @@ For affected settings, see `which-key-replacement-alist', `which-key-ellipsis' Default is \" → \", unless `which-key-dont-use-unicode' is non nil, in which case the default is \" : \"." :type 'string + :set-after '(which-key-dont-use-unicode) :package-version "1.0" :version "30.1") (defcustom which-key-ellipsis @@ -146,6 +147,7 @@ Default is \"…\", unless `which-key-dont-use-unicode' is non nil, in which case the default is \"..\". This can also be the empty string to truncate without using any ellipsis." :type 'string + :set-after '(which-key-dont-use-unicode) :package-version "1.0" :version "30.1") (defcustom which-key-prefix-prefix "+" commit 543ad34ee4d030e0f0f6f900d8606288c4cdba93 Author: Philip Kaludercic Date: Tue Jun 18 10:42:12 2024 +0200 Remove :underline from 'which-key-highlighted-command-face ' * lisp/which-key.el (which-key-highlighted-command-face): To avoid using properties that might not be supported on all displays, we instead inherit from the semantic face 'highlight'. diff --git a/lisp/which-key.el b/lisp/which-key.el index 51b8ece457f..45f8a31364a 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -595,9 +595,9 @@ it." :package-version "1.0" :version "30.1") (defface which-key-highlighted-command-face - '((t . (:inherit which-key-command-description-face :underline t))) - "Default face for command description. -To be highlighted, it must be a command and match a string in + '((t . (:inherit (which-key-command-description-face highlight)))) + "Default face for highlighted command descriptions. +A command is highlighted, when it matches a string in `which-key-highlighted-command-list'." :group 'which-key-faces :package-version "1.0" :version "30.1") commit b0b7df823b31b8213fb6e755de3105233415bd65 Author: Philip Kaludercic Date: Tue Jun 18 10:41:01 2024 +0200 ; * lisp/which-key.el (which-key--process-page): Use ?\s diff --git a/lisp/which-key.el b/lisp/which-key.el index a4720040f7a..51b8ece457f 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -2251,13 +2251,13 @@ prefix, and a page count." (format (concat "%-" (int-to-string first-col-width) "s") page-cnt) - (make-string first-col-width 32))) + (make-string first-col-width ?\s))) 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))) + new-end (concat "\n" (make-string first-col-width ?\s))) (cons (concat first-line (mapconcat #'identity (cdr lines) new-end)) nil)))) commit e0190c4fb80182e4436f394213d46fafebc03469 Author: Philip Kaludercic Date: Tue Jun 18 10:40:01 2024 +0200 Prevent which-key faces from over-extending during formatting * lisp/which-key.el (which-key--pad-column): Instead of injecting the description using a left-aligned format-string (%-[n]s), we manually add the necessary padding so that the text properties don't extend beyond the description. This allows us to use a face with a background without it extending until the end of a column. See also 63a6fb2a7a02ca88835c3fd473894d3b7d39ff15 for a similar issue with Quick Help. diff --git a/lisp/which-key.el b/lisp/which-key.el index a2355527dd3..a4720040f7a 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -2005,10 +2005,12 @@ that width." col-keys 2 which-key-min-column-description-width))) (col-width (+ col-key-width col-sep-width col-desc-width)) - (col-format (concat "%" (int-to-string col-key-width) - "s%s%-" (int-to-string col-desc-width) "s"))) + (col-format (concat "%" (int-to-string col-key-width) "s%s%s"))) (cons col-width - (mapcar (lambda (k) (apply #'format col-format k)) + (mapcar (pcase-lambda (`(,key ,sep ,desc ,_doc)) + (concat + (format col-format key sep desc) + (make-string (- col-desc-width (length desc)) ?\s))) col-keys)))) (defun which-key--partition-list (n list) commit fb04a51894874aba3f9981723981ca336ba5ff77 Author: Po Lu Date: Tue Jun 18 15:53:18 2024 +0800 Fix window class of Android tooltips * java/org/gnu/emacs/EmacsWindow.java (getWindowLayoutParams): Declare as a panel, rather than an attached dialog. diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 5a4e04ae169..342190113b7 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -396,7 +396,7 @@ private static class Coordinate rect = getGeometry (); flags |= WindowManager.LayoutParams.FLAG_NOT_FOCUSABLE; flags |= WindowManager.LayoutParams.FLAG_NOT_TOUCHABLE; - type = WindowManager.LayoutParams.TYPE_APPLICATION_ATTACHED_DIALOG; + type = WindowManager.LayoutParams.TYPE_APPLICATION_PANEL; params = new WindowManager.LayoutParams (rect.width (), rect.height (), commit e0871780ac44336a30e76abb91459cf5d0e5e6e2 Author: Stefan Kangas Date: Sun Jun 16 13:39:26 2024 +0200 ; Fix more checkdoc warnings in which-key.el * lisp/which-key.el (which-key-special-keys) (which-key-highlighted-command-face, which-key--safe-lookup-key) (which-key--safe-lookup-key-description) (which-key-add-keymap-based-replacements) (which-key-add-key-based-replacements) (which-key--fit-buffer-to-window-horizontally) (which-key--popup-max-dimensions) (which-key--propertize-description, which-key--format-and-replace) (which-key--get-bindings, which-key--list-to-pages) (which-key--create-pages-1, which-key--create-pages) (which-key--get-popup-map, which-key-show-major-mode): Fix checkdoc warnings. diff --git a/lisp/which-key.el b/lisp/which-key.el index 5ca88a682a5..a2355527dd3 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -238,8 +238,8 @@ face to apply)." (defcustom which-key-special-keys '() "These keys will automatically be truncated to one character. -They also have `which-key-special-key-face' applied to them. This -is disabled by default. An example configuration is +They also have `which-key-special-key-face' applied to them. This +is disabled by default. An example configuration is \(setq which-key-special-keys \\='(\"SPC\" \"TAB\" \"RET\" \"ESC\" \"DEL\")\)" :type '(repeat string) @@ -596,8 +596,9 @@ it." (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'." + "Default face for command description. +To be highlighted, it must be a command and match a string in +`which-key-highlighted-command-list'." :group 'which-key-faces :package-version "1.0" :version "30.1") @@ -762,8 +763,8 @@ Used when `which-key-popup-type' is frame.") (defsubst which-key--safe-lookup-key (keymap key) "Version of `lookup-key' that allows KEYMAP to be nil. -Also convert numeric results of `lookup-key' to nil. KEY is not -checked." +Also convert numeric results of `lookup-key' to nil. +KEY is not checked." (when (keymapp keymap) (let ((result (lookup-key keymap key))) (when (and result (not (numberp result))) @@ -771,8 +772,8 @@ checked." (defsubst which-key--safe-lookup-key-description (keymap key) "Version of `lookup-key' that allows KEYMAP to be nil. -Also convert numeric results of `lookup-key' to nil. KEY -should be formatted as an input for `kbd'." +Also convert numeric results of `lookup-key' to nil. +KEY should be formatted as an input for `kbd'." (let ((key (ignore-errors (kbd key)))) (when (and key (keymapp keymap)) (let ((result (lookup-key keymap key))) @@ -1006,12 +1007,12 @@ but more functional." ;;;###autoload (defun which-key-add-keymap-based-replacements (keymap key replacement &rest more) "Replace the description of KEY using REPLACEMENT in KEYMAP. -KEY should take a format suitable for use in `kbd'. REPLACEMENT +KEY should take a format suitable for use in `kbd'. REPLACEMENT should be a cons cell of the form \(STRING . COMMAND\) for each REPLACEMENT, where STRING is the replacement string and COMMAND is a symbol corresponding to the intended command to be -replaced. COMMAND can be nil if the binding corresponds to a key -prefix. An example is +replaced. COMMAND can be nil if the binding corresponds to a key +prefix. An example is \(which-key-add-keymap-based-replacements global-map \"C-x w\" \\='\(\"Save as\" . write-file\)\). @@ -1038,8 +1039,8 @@ for REPLACEMENT will eventually be removed." (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 +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\"\) @@ -1260,7 +1261,7 @@ is shown, or if there is no need to start the closing timer." (&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" +call signature in different Emacs versions" (let ((fit-window-to-buffer-horizontally t) (window-min-height 1)) (apply #'fit-window-to-buffer window params))) @@ -1364,7 +1365,7 @@ Display window alist: %s" (defun which-key--popup-max-dimensions () "Return maximum dimension available for popup. Dimension functions should return the maximum possible (height -. width) of the intended popup. SELECTED-WINDOW-WIDTH is the +. width) of the intended popup. SELECTED-WINDOW-WIDTH is the width of currently active window, not the which-key buffer window." (cl-ecase which-key-popup-type @@ -1738,7 +1739,7 @@ cell" el))))) (description group local hl-face &optional original-description) "Add face to DESCRIPTION. The face chosen depends on whether the description represents a -group or a command. Also make some minor adjustments to the +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 @@ -1813,7 +1814,7 @@ return the docstring." "Make list of key bindings with separators and descriptions. 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)." +alists. Return a list (key separator description)." (let ((sep-w-face (which-key--propertize which-key-separator 'face 'which-key-separator-face)) @@ -1949,8 +1950,8 @@ EVIL is non-nil, extract active evil bidings." (defun which-key--get-bindings (&optional prefix keymap filter recursive) "Collect key bindings. If KEYMAP is nil, collect from current buffer using the current -key sequence as a prefix. Otherwise, collect from KEYMAP. FILTER -is a function to use to filter the bindings. If RECURSIVE is +key sequence as a prefix. Otherwise, collect from KEYMAP. FILTER +is a function to use to filter the bindings. If RECURSIVE is non-nil, then bindings are collected recursively for all prefixes." (let* ((unformatted (cond ((keymapp keymap) @@ -2020,7 +2021,7 @@ that width." (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 `which-key--pages' object that holds the page strings, +Return a `which-key--pages' object that holds the page strings, as well as metadata." (let ((cols-w-widths (mapcar (lambda (c) (which-key--pad-column c avl-width)) (which-key--partition-list avl-lines keys))) @@ -2063,7 +2064,7 @@ as well as metadata." (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 +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 @@ -2088,7 +2089,7 @@ should be minimized." (defun which-key--create-pages (keys &optional prefix-keys prefix-title) "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 +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)) @@ -2209,7 +2210,7 @@ Include prefix arguments." (which-key--propertize dash 'face 'which-key-key-face))))) (defun which-key--get-popup-map () - "Generate transient-map for use in the top level binding display." + "Generate transient map for use in the top level binding display." (unless which-key--automatic-display (let ((map (make-sparse-keymap))) (define-key map (kbd which-key-paging-key) #'which-key-C-h-dispatch) @@ -2406,7 +2407,7 @@ Usually this is `describe-prefix-bindings'." (defun which-key-show-major-mode (&optional all) "Show top-level bindings in the map of the current major mode. This function will also detect evil bindings made using -`evil-define-key' in this map. These bindings will depend on the +`evil-define-key' in this map. These bindings will depend on the current evil state." (interactive "P") (let ((map-sym (intern (format "%s-map" major-mode)))) commit 43a22401191592c4d367d80af5de2b7c0e7efcad Author: Philip Kaludercic Date: Sat Jun 15 21:24:46 2024 +0200 Fix :version tag for 'which-key' custom data * lisp/which-key.el (which-key-idle-delay) (which-key-idle-secondary-delay, which-key-echo-keystrokes) (which-key-max-description-length) (which-key-min-column-description-width) (which-key-add-column-padding, which-key-unicode-correction) (which-key-dont-use-unicode, which-key-separator) (which-key-ellipsis, which-key-prefix-prefix) (which-key-compute-remaps, which-key-replacement-alist) (which-key-allow-multiple-replacements) (which-key-show-docstrings, which-key-highlighted-command-list) (which-key-special-keys, which-key-buffer-name) (which-key-show-prefix, which-key-popup-type) (which-key-min-display-lines, which-key-max-display-columns) (which-key-side-window-location, which-key-side-window-slot) (which-key-side-window-max-width) (which-key-side-window-max-height, which-key-frame-max-width) (which-key-frame-max-height) (which-key-allow-imprecise-window-fit) (which-key-show-remaining-keys, which-key-sort-order) (which-key-sort-uppercase-first, which-key-paging-prefixes) (which-key-paging-key, which-key-use-C-h-commands) (which-key-show-early-on-C-h, which-key-is-verbose) (which-key-preserve-window-configuration) (which-key-hide-alt-key-translations, which-key-delay-functions) (which-key-allow-regexps, which-key-inhibit-regexps) (which-key-show-transient-maps, which-key-init-buffer-hook) (which-key-key-face, which-key-separator-face) (which-key-note-face, which-key-command-description-face) (which-key-local-map-description-face) (which-key-highlighted-command-face) (which-key-group-description-face, which-key-special-key-face) (which-key-docstring-face) (which-key-custom-popup-max-dimensions-function) (which-key-custom-hide-popup-function) (which-key-custom-show-popup-function, which-key-lighter) (which-key-inhibit-display-hook) (which-key-this-command-keys-function) (which-key-allow-evil-operators) (which-key-show-operator-state-maps): Rename :version to :package-version and add new :version tags indicating that 'which-key' was added with Emacs 30. diff --git a/lisp/which-key.el b/lisp/which-key.el index cac23c88d74..5ca88a682a5 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -62,7 +62,7 @@ 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)." :type 'float - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-idle-secondary-delay nil "Seconds to wait for which-key to pop up after initial display. @@ -70,7 +70,7 @@ 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." :type '(choice float (const :tag "Disabled" nil)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-echo-keystrokes (if (and echo-keystrokes (> (+ echo-keystrokes 0.01) @@ -83,7 +83,7 @@ This only applies if `which-key-popup-type' is minibuffer or `which-key-idle-delay' or else the keystroke echo will erase the which-key popup." :type 'float - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-max-description-length 27 "Truncate the description of keys to this length. @@ -96,17 +96,17 @@ before. Truncation is done using `which-key-ellipsis'." (integer :tag "Width in characters") (float :tag "Use fraction of available width") function) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-min-column-description-width 0 "Every column should at least have this width." :type 'natnum - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-add-column-padding 0 "Additional spaces to add to the left of each key column." :type 'integer - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-unicode-correction 3 "Correction for wide unicode characters. @@ -122,14 +122,14 @@ additional ASCII character in the which-key buffer. Increase this number if you are seeing characters get cutoff on the right side of the which-key popup." :type 'integer - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-dont-use-unicode nil "If non-nil, don't use any unicode characters in default setup. For affected settings, see `which-key-replacement-alist', `which-key-ellipsis' `which-key-separator'." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-separator (if which-key-dont-use-unicode " : " " → ") @@ -137,7 +137,7 @@ For affected settings, see `which-key-replacement-alist', `which-key-ellipsis' Default is \" → \", unless `which-key-dont-use-unicode' is non nil, in which case the default is \" : \"." :type 'string - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-ellipsis (if which-key-dont-use-unicode ".." "…") @@ -146,20 +146,20 @@ Default is \"…\", unless `which-key-dont-use-unicode' is non nil, in which case the default is \"..\". This can also be the empty string to truncate without using any ellipsis." :type 'string - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-prefix-prefix "+" "Prefix string to indicate a key bound to a keymap. Default is \"+\"." :type 'string - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-compute-remaps nil "If non-nil, show remapped commands. This applies to commands that have been remapped given the currently active keymaps." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-replacement-alist `(((nil . "which-key-show-next-page-no-cycle") . (nil . "wk next pg")) @@ -202,7 +202,7 @@ non-nil value." (choice regexp (const nil))) :value-type (cons (choice string (const nil)) (choice string (const nil)))) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-allow-multiple-replacements nil "Allow a key binding to be modified by multiple elements. @@ -211,7 +211,7 @@ patterns in `which-key-replacement-alist'. When nil, only the first match is used to perform replacements from `which-key-replacement-alist'." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-show-docstrings nil "If non-nil, show each command's docstring in the which-key popup. @@ -224,7 +224,7 @@ you use this feature." (const :tag "Do not show docstrings" nil) (const :tag "Add docstring to command names" t) (const :tag "Replace command name with docstring" docstring-only)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-highlighted-command-list '() "Rules used to highlight certain commands. @@ -234,7 +234,7 @@ matching command names and use the element is a cons cell, it should take the form (regexp . face to apply)." :type '(repeat (choice string (cons regexp face))) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-special-keys '() "These keys will automatically be truncated to one character. @@ -243,12 +243,12 @@ is disabled by default. An example configuration is \(setq which-key-special-keys \\='(\"SPC\" \"TAB\" \"RET\" \"ESC\" \"DEL\")\)" :type '(repeat string) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-buffer-name " *which-key*" "Name of which-key buffer." :type 'string - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-show-prefix 'echo "Whether to and where to display the current prefix sequence. @@ -260,7 +260,7 @@ and nil. nil turns the feature off." (const :tag "In the echo area" echo) (const :tag "In the mode-line" mode-line) (const :tag "Hide" nil)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-popup-type 'side-window "Supported types are minibuffer, side-window, frame, and custom." @@ -268,18 +268,18 @@ and nil. nil turns the feature off." (const :tag "Show in side window" side-window) (const :tag "Show in popup frame" frame) (const :tag "Use your custom display functions" custom)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-min-display-lines 1 "Minimum number of horizontal lines to display in the which-key buffer." :type 'integer - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-max-display-columns nil "Maximum number of columns to display in the which-key buffer. A value of nil means don't impose a maximum." :type '(choice integer (const :tag "Unbounded" nil)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-side-window-location 'bottom "Location of which-key popup when `which-key-popup-type' is side-window. @@ -293,7 +293,7 @@ location is tried." (const top) (const (right bottom)) (const (bottom right))) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-side-window-slot 0 "The `slot' to use for `display-buffer-in-side-window'. @@ -307,31 +307,31 @@ 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." :type 'integer - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-side-window-max-width 0.333 "Maximum width of which-key popup when type is side-window. This variable can also be a number between 0 and 1. In that case, it denotes a percentage out of the frame's width." :type 'float - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-side-window-max-height 0.25 "Maximum height of which-key popup when type is side-window. This variable can also be a number between 0 and 1. In that case, it denotes a percentage out of the frame's height." :type 'float - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-frame-max-width 60 "Maximum width of which-key popup when type is frame." :type 'natnum - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-frame-max-height 20 "Maximum height of which-key popup when type is frame." :type 'natnum - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-allow-imprecise-window-fit (not (display-graphic-p)) "Allow which-key to use a simpler method for resizing the popup. @@ -341,13 +341,13 @@ this on may help. See https://github.com/justbur/emacs-which-key/issues/130 and https://github.com/justbur/emacs-which-key/issues/225." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-show-remaining-keys nil "Show remaining keys in last slot, when keys are hidden." :type '(radio (const :tag "Yes" t) (const :tag "No" nil)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-sort-order #'which-key-key-order "Order in which the key bindings are sorted. @@ -367,25 +367,25 @@ information." (function-item which-key-description-order) (function-item which-key-prefix-then-key-order) (function-item which-key-local-then-key-order)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-sort-uppercase-first t "If non-nil, uppercase comes before lowercase in sorting. This applies to the function chosen in `which-key-sort-order'. Otherwise, the order is reversed." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-paging-prefixes '() "Enable paging for these prefixes." :type '(repeat string) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-paging-key "" "Key to use for changing pages. Bound after each of the prefixes in `which-key-paging-prefixes'" :type 'string - :version "1.0") + :package-version "1.0" :version "30.1") ;; (defcustom which-key-undo-key nil ;; "Key (string) to use for undoing keypresses. Bound recursively @@ -404,7 +404,7 @@ Normally `help-char' after a prefix calls `describe-prefix-bindings'. This changes that command to a which-key paging command when `which-key-mode' is active." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-show-early-on-C-h nil "Allow \\`C-h' (`help-char') to trigger which-key popup before timer. @@ -420,12 +420,12 @@ using \\`C-h'. Note that `which-key-idle-delay' should be set before turning on `which-key-mode'." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-is-verbose nil "Whether to warn about potential mistakes in configuration." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-preserve-window-configuration nil "Save and restore window configuration around which-key popup display. @@ -435,7 +435,7 @@ prevents which-key from changing window position of visible buffers. Only takken into account when popup type is side-window." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defvar which-key-C-h-map-prompt (concat " \\" @@ -503,7 +503,7 @@ of terminals issue META modifier for the Alt key. See Info node `(emacs)Modifier Keys'." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-delay-functions nil "List of functions that may delay the which-key popup. @@ -519,7 +519,7 @@ 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'." :type '(repeat function) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-allow-regexps nil "A list of regexp strings to use to filter key sequences. @@ -527,7 +527,7 @@ 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'." :type '(repeat regexp) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-inhibit-regexps nil "A list of regexp strings to use to filter key sequences. @@ -535,7 +535,7 @@ 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'." :type '(repeat regexp) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-show-transient-maps nil "Show keymaps created by `set-transient-map' when applicable. @@ -544,7 +544,7 @@ More specifically, detect when `overriding-terminal-local-map' is set (this is the keymap used by `set-transient-map') and display it." :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (make-obsolete-variable 'which-key-enable-extended-define-key @@ -555,7 +555,7 @@ it." (defcustom which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized." :type 'hook - :version "1.0") + :package-version "1.0" :version "30.1") ;;;; Faces @@ -568,56 +568,56 @@ it." '((t . (:inherit font-lock-constant-face))) "Face for which-key keys." :group 'which-key-faces - :version "1.0") + :package-version "1.0" :version "30.1") (defface which-key-separator-face '((t . (:inherit font-lock-comment-face))) "Face for the separator (default separator is an arrow)." :group 'which-key-faces - :version "1.0") + :package-version "1.0" :version "30.1") (defface which-key-note-face '((t . (:inherit which-key-separator-face))) "Face for notes or hints occasionally provided." :group 'which-key-faces - :version "1.0") + :package-version "1.0" :version "30.1") (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 - :version "1.0") + :package-version "1.0" :version "30.1") (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 - :version "1.0") + :package-version "1.0" :version "30.1") (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 - :version "1.0") + :package-version "1.0" :version "30.1") (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 - :version "1.0") + :package-version "1.0" :version "30.1") (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 - :version "1.0") + :package-version "1.0" :version "30.1") (defface which-key-docstring-face '((t . (:inherit which-key-note-face))) "Face for docstrings." :group 'which-key-faces - :version "1.0") + :package-version "1.0" :version "30.1") ;;;; Custom popup @@ -628,14 +628,14 @@ 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 '(choice function (const nil)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-custom-hide-popup-function nil "Set a custom hide-popup function. It takes no arguments and the return value is ignored." :group 'which-key :type '(choice function (const nil)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-custom-show-popup-function nil "Set a custom show-popup function. @@ -644,13 +644,13 @@ width) in lines and characters respectively. The return value is ignored." :group 'which-key :type '(choice function (const nil)) - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-lighter " WK" "Minor mode lighter to use in the mode-line." :group 'which-key :type 'string - :version "1.0") + :package-version "1.0" :version "30.1") (defvar which-key-inhibit nil "Prevent which-key from popping up momentarily. @@ -667,7 +667,7 @@ popup. If any function returns a non-nil value, the popup will not display." :group 'which-key :type 'hook - :version "1.0") + :package-version "1.0" :version "30.1") (defvar which-key-keymap-history nil "History of keymap selections. @@ -798,7 +798,7 @@ allow which-key to support packages that insert non-standard `keys' into the key sequence being read by Emacs." :group 'which-key :type 'function - :version "1.0") + :package-version "1.0" :version "30.1") ;;;; Evil @@ -812,7 +812,7 @@ setting this to non-nil will override this behavior for evil operators." :group 'which-key :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defcustom which-key-show-operator-state-maps nil "Show the keys following an evil command that reads a motion. @@ -822,7 +822,7 @@ might be some valid keys missing and it might be showing some invalid keys." :group 'which-key :type 'boolean - :version "1.0") + :package-version "1.0" :version "30.1") (defun which-key-evil-this-operator-p () (and which-key-allow-evil-operators commit f2077bca79ef96cdd8ccb840623a62824d6e15bc Author: Stefan Kangas Date: Sat Jun 15 16:31:14 2024 +0200 Bump `which-key` minimum Emacs version to 25.1 * lisp/which-key.el: Bump minimum required Emacs version to 25.1 since the package depends on `universal-argument--description'. This was detected by package-lint. diff --git a/lisp/which-key.el b/lisp/which-key.el index 6d61bfde642..cac23c88d74 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; Version: 3.6.0 -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "25.1")) ;; This file is part of GNU Emacs. commit 1efbc8ff440d52168f22e6256ec8f55e98953570 Author: Stefan Kangas Date: Sat Jun 15 16:29:36 2024 +0200 Fix checkdoc warnings in which-key.el * lisp/which-key.el (which-key, which-key-idle-secondary-delay) (which-key-replacement-alist) (which-key-allow-multiple-replacements, which-key-show-docstrings) (which-key-highlighted-command-list, which-key-show-prefix) (which-key-sort-order, which-key-sort-uppercase-first) (which-key-use-C-h-commands, which-key-show-early-on-C-h) (which-key-preserve-window-configuration, which-key-C-h-map) (which-key-delay-functions, which-key-inhibit-regexps) (which-key-faces, which-key-key-face, which-key-separator-face) (which-key-note-face, which-key-command-description-face) (which-key-local-map-description-face, which-key-special-key-face) (which-key-inhibit-display-hook) (which-key-this-command-keys-function, which-key-mode) (which-key--init-buffer, which-key--get-menu-item-binding) (which-key--get-keymap-bindings, which-key-reload-key-sequence) (which-key-show-major-mode, which-key-show-full-major-mode) (which-key-C-h-dispatch): Fix checkdoc warnings. diff --git a/lisp/which-key.el b/lisp/which-key.el index e93ef9184aa..6d61bfde642 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -50,7 +50,7 @@ ;;; Options (defgroup which-key nil - "Customization options for which-key-mode." + "Customization options for `which-key-mode'." :group 'help :prefix "which-key-") @@ -67,7 +67,7 @@ recommended (defcustom which-key-idle-secondary-delay nil "Seconds to wait for which-key to pop up after initial display. This makes it possible to shorten the delay for subsequent popups -in the same key sequence. The default is for this value to be +in the same key sequence. The default is for this value to be nil, which disables this behavior." :type '(choice float (const :tag "Disabled" nil)) :version "1.0") @@ -173,15 +173,15 @@ 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 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 +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 +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\"\)\) @@ -207,7 +207,7 @@ non-nil value." (defcustom which-key-allow-multiple-replacements nil "Allow a key binding to be modified by multiple elements. When non-nil, this allows a single key binding to match multiple -patterns in `which-key-replacement-alist'. When nil, only the +patterns in `which-key-replacement-alist'. When nil, only the first match is used to perform replacements from `which-key-replacement-alist'." :type 'boolean @@ -216,8 +216,8 @@ first match is used to perform replacements from (defcustom which-key-show-docstrings nil "If non-nil, show each command's docstring in the which-key popup. This will only display the docstring up to the first line -break. If you set this variable to the symbol docstring-only, -then the command's name with be omitted. You probably also want +break. If you set this variable to the symbol docstring-only, +then the command's name with be omitted. You probably also want to adjust `which-key-max-description-length' at the same time if you use this feature." :type '(radio @@ -230,7 +230,7 @@ you use this feature." "Rules 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 +`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)." :type '(repeat (choice string (cons regexp face))) @@ -253,7 +253,7 @@ is disabled by default. An example configuration is (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." +and nil. nil turns the feature off." :type '(radio (const :tag "Left of the keys" left) (const :tag "In the first line" top) (const :tag "In the last line" bottom) @@ -352,8 +352,7 @@ and https://github.com/justbur/emacs-which-key/issues/225." (defcustom which-key-sort-order #'which-key-key-order "Order in which the key bindings are sorted. If nil, do not resort the output from `describe-buffer-bindings' -which groups by mode. Ordering options -are +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 @@ -373,7 +372,7 @@ information." (defcustom which-key-sort-uppercase-first t "If non-nil, uppercase comes before lowercase in sorting. This applies to the function chosen in -`which-key-sort-order'. Otherwise, the order is reversed." +`which-key-sort-order'. Otherwise, the order is reversed." :type 'boolean :version "1.0") @@ -400,20 +399,20 @@ Bound after each of the prefixes in `which-key-paging-prefixes'" ;; :type '(repeat symbol)) (defcustom which-key-use-C-h-commands t - "Use C-h (`help-char') for paging if non-nil. + "Use \\`C-h' (`help-char') for paging if non-nil. Normally `help-char' after a prefix calls -`describe-prefix-bindings'. This changes that command to a -which-key paging command when which-key-mode is active." +`describe-prefix-bindings'. This changes that command to a +which-key paging command when `which-key-mode' is active." :type 'boolean :version "1.0") (defcustom which-key-show-early-on-C-h nil - "Allow C-h (`help-char') to trigger which-key popup before timer. + "Allow \\`C-h' (`help-char') to trigger which-key popup before timer. Show the which-key buffer if `help-char' is pressed in the middle of a prefix before the which-key buffer would normally be -triggered by the time. If combined with the following settings, +triggered by the time. If combined with the following settings, which-key will effectively only show when triggered \"manually\" -using C-h. +using \\`C-h'. \(setq `which-key-idle-delay' 10000) \(setq `which-key-idle-secondary-delay' 0.05) @@ -431,7 +430,7 @@ Note that `which-key-idle-delay' should be set before turning on (defcustom which-key-preserve-window-configuration nil "Save and restore window configuration around which-key popup display. If non-nil, save window configuration before which-key buffer is -shown and restore it after which-key buffer is hidden. It +shown and restore it after which-key buffer is hidden. It prevents which-key from changing window position of visible buffers. Only takken into account when popup type is side-window." @@ -482,7 +481,7 @@ This string is fed into `substitute-command-keys'") ("9" . which-key-digit-argument))) (define-key map (car bind) (cdr bind))) map) - "Keymap for C-h commands.") + "Keymap for \\`C-h' commands.") (defvar which-key--paging-functions (list #'which-key-C-h-dispatch @@ -510,11 +509,11 @@ See Info node `(emacs)Modifier Keys'." "List of functions that may delay the which-key popup. 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, +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 +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 +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 @@ -533,7 +532,7 @@ key sequences is what is produced by `key-description'." (defcustom which-key-inhibit-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 cannot match one of the regexps in this list. The format of +it cannot match one of the regexps in this list. The format of the key sequences is what is produced by `key-description'." :type '(repeat regexp) :version "1.0") @@ -561,37 +560,37 @@ it." ;;;; Faces (defgroup which-key-faces nil - "Faces for which-key-mode" + "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" + "Face for which-key keys." :group 'which-key-faces :version "1.0") (defface which-key-separator-face '((t . (:inherit font-lock-comment-face))) - "Face for the separator (default separator is an arrow)" + "Face for the separator (default separator is an arrow)." :group 'which-key-faces :version "1.0") (defface which-key-note-face '((t . (:inherit which-key-separator-face))) - "Face for notes or hints occasionally provided" + "Face for notes or hints occasionally provided." :group 'which-key-faces :version "1.0") (defface which-key-command-description-face '((t . (:inherit font-lock-function-name-face))) - "Face for the key description when it is a command" + "Face for the key description when it is a command." :group 'which-key-faces :version "1.0") (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'" + "Face for the key description when it is found in `current-local-map'." :group 'which-key-faces :version "1.0") @@ -610,7 +609,7 @@ and it matches a string in `which-key-highlighted-command-list'." (defface which-key-special-key-face '((t . (:inherit which-key-key-face :inverse-video t :weight bold))) - "Face for special keys (SPC, TAB, RET)" + "Face for special keys (\\`SPC', \\`TAB', \\`RET')." :group 'which-key-faces :version "1.0") @@ -664,7 +663,7 @@ execution of a command, as in (defcustom which-key-inhibit-display-hook nil "Hook run before display of which-key popup. Each function in the hook is run before displaying the which-key -popup. If any function returns a non-nil value, the popup will +popup. If any function returns a non-nil value, the popup will not display." :group 'which-key :type 'hook @@ -796,7 +795,7 @@ should be formatted as an input for `kbd'." "Function used to retrieve current key sequence. The purpose of allowing this variable to be customized is to allow which-key to support packages that insert non-standard -`keys' into the key sequence being read by emacs." +`keys' into the key sequence being read by Emacs." :group 'which-key :type 'function :version "1.0") @@ -888,7 +887,7 @@ disable support." ;;;###autoload (define-minor-mode which-key-mode - "Toggle which-key-mode." + "Toggle `which-key-mode'." :global t :group 'which-key :lighter which-key-lighter @@ -928,7 +927,7 @@ disable support." (which-key--stop-timer))) (defun which-key--init-buffer () - "Initialize which-key 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 @@ -1857,7 +1856,7 @@ Requires `which-key-compute-remaps' to be non-nil." binding)))) (defun which-key--get-menu-item-binding (def) - "Retrieve binding for menu-item" + "Retrieve binding for menu-item." ;; see `keymap--menu-item-binding' (let* ((binding (nth 2 def)) (plist (nthcdr 3 def)) @@ -1925,7 +1924,7 @@ Requires `which-key-compute-remaps' to be non-nil." "Retrieve top-level bindings from KEYMAP. PREFIX limits bindings to those starting with this key sequence. START is a list of existing bindings to add to. If ALL -is non-nil, recursively retrieve all bindings below PREFIX. If +is non-nil, recursively retrieve all bindings below PREFIX. If EVIL is non-nil, extract active evil bidings." (let ((bindings start) (ignore '(self-insert-command ignore ignore-event company-ignore)) @@ -2329,7 +2328,7 @@ enough space based on your settings and frame size." prefix-keys) "Simulate entering the key sequence KEY-SEQ. KEY-SEQ should be a list of events as produced by `listify-key-sequence'. If nil, KEY-SEQ defaults to -`which-key--current-key-list'. Any prefix arguments that were +`which-key--current-key-list'. Any prefix arguments that were used are reapplied to the new key sequence." (let* ((key-seq (or key-seq (which-key--current-key-list))) (next-event (mapcar (lambda (ev) (cons t ev)) key-seq))) @@ -2408,7 +2407,7 @@ Usually this is `describe-prefix-bindings'." "Show top-level bindings in the map of the current major mode. This function will also detect evil bindings made using `evil-define-key' in this map. These bindings will depend on the -current evil state. " +current evil state." (interactive "P") (let ((map-sym (intern (format "%s-map" major-mode)))) (if (and (boundp map-sym) (keymapp (symbol-value map-sym))) @@ -2423,8 +2422,8 @@ current evil state. " (defun which-key-show-full-major-mode () "Show all bindings in the map of the current major mode. This function will also detect evil bindings made using -`evil-define-key' in this map. These bindings will depend on the -current evil state. " +`evil-define-key' in this map. These bindings will depend on the +current evil state." (interactive) (which-key-show-major-mode t)) @@ -2485,7 +2484,7 @@ PREFIX should be a string suitable for `kbd'." ;;;###autoload (defun which-key-C-h-dispatch () - "Dispatch C-h commands by looking up key in `which-key-C-h-map'. + "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) commit 847b202c1c15c23239bf07ab619229f103b408a5 Author: Philip Kaludercic Date: Sat Jun 15 14:55:20 2024 +0200 * etc/NEWS: Mention the addition of 'which-key' diff --git a/etc/NEWS b/etc/NEWS index 302cd30a135..4916c18e53a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1982,6 +1982,11 @@ To revert to the previous behavior, set the (also new) variable 'async-shell-command-mode' to 'shell-mode'. Any hooks or mode-specific variables used should be adapted appropriately. +** New package Which-Key +The 'which-key' package from GNU ELPA is now included in Emacs. It +implements the 'which-key-mode' that displays a table of key bindings +upon entering a partial key chord and waiting for a moment. + * Incompatible Lisp Changes in Emacs 30.1 commit 4b2781f16d72985dc8ba5d14cd6821c8f1cd1439 Author: Philip Kaludercic Date: Sat Jun 15 14:48:58 2024 +0200 * lisp/which-key.el: Clean up file header diff --git a/lisp/which-key.el b/lisp/which-key.el index f53226ee969..e93ef9184aa 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -5,9 +5,10 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; Version: 3.6.0 -;; Keywords: ;; Package-Requires: ((emacs "24.4")) +;; This file is part of GNU Emacs. + ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or @@ -23,16 +24,15 @@ ;;; 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. +;; The `which-key' 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. ;;; Code: commit f1c06968eeac0b8caa39d385f436985dc448f40c Merge: d3bdf11d808 1e89fa000e9 Author: Philip Kaludercic Date: Sat Jun 15 14:44:06 2024 +0200 Merge remote-tracking branch 'github-which-key/master' commit 1e89fa000e9ba9549f15ef57abccd118d5f2fe1a Author: Jeremy Bryant Date: Wed Apr 10 22:56:27 2024 +0100 Remove unnecessary (delq nil...). This is presumed to be an artifacto of an old default. * which-key.el (which-key-replacement-alist): Remove unnecessary (delq nil...). diff --git a/which-key.el b/which-key.el index 0d44a61020a..f53226ee969 100644 --- a/which-key.el +++ b/which-key.el @@ -162,12 +162,11 @@ currently active keymaps." :version "1.0") (defcustom which-key-replacement-alist - (delq nil - `(((nil . "which-key-show-next-page-no-cycle") . (nil . "wk next pg")) - ,@(unless which-key-dont-use-unicode - '((("") . ("←")) - (("") . ("→")))) - (("<\\([[:alnum:]-]+\\)>") . ("\\1")))) + `(((nil . "which-key-show-next-page-no-cycle") . (nil . "wk next pg")) + ,@(unless which-key-dont-use-unicode + '((("") . ("←")) + (("") . ("→")))) + (("<\\([[:alnum:]-]+\\)>") . ("\\1"))) "ALIST for manipulating display of binding descriptions. Each element of the list is a nested cons cell with the format commit b3974a28f39f535fae7a4fae14255a34a52569e8 Author: Jeremy Bryant Date: Tue Apr 9 22:54:39 2024 +0100 Remove old backport version of universal-argument--description In preparation for the move to Emacs core, this is no longer needed. Furthermore, the backport was of emacs25 on 2015-12-04 so is unlikely to affect most current installations in the meantime. * which-key.el: Remove old backport of 2025-12-04. (which-key--full-prefix): Use built-in universal-argument--description. diff --git a/which-key.el b/which-key.el index 0e14c76df95..0d44a61020a 100644 --- a/which-key.el +++ b/which-key.el @@ -2194,32 +2194,13 @@ Actual lines: %s" (which-key--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. Include 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) + (universal-argument--description) (when prefix-arg " ") prefix-keys)) (dash (if (and (not (string= prefix-keys "")) commit ba323d6712d54806aa82847d017e94eafcf99d6f Author: Justin Burkett Date: Tue Apr 23 09:20:28 2024 -0400 Revert "* which-key.el (which-key--partition-list): Replace cl-subseq by take" This reverts commit 94a29cda9f75c9901667bf45ff25bd8c892cb416. diff --git a/which-key.el b/which-key.el index 1ece569e7ed..0e14c76df95 100644 --- a/which-key.el +++ b/which-key.el @@ -2016,7 +2016,7 @@ that width." "Partition LIST into N-sized sublists." (let (res) (while list - (setq res (cons (take (min n (length list)) list) res) + (setq res (cons (cl-subseq list 0 (min n (length list))) res) list (nthcdr n list))) (nreverse res))) commit e21ee102ed5f2f60bd0bc47382c70aa8fd5b9c5b Author: Justin Burkett Date: Sat Apr 13 16:03:47 2024 -0400 Add more debugging information diff --git a/which-key.el b/which-key.el index beb111211a8..1ece569e7ed 100644 --- a/which-key.el +++ b/which-key.el @@ -1284,6 +1284,10 @@ call signature in different emacs versions" (window-height . (lambda (w) (fit-window-to-buffer w nil 1))) (side . ,which-key-side-window-location) (slot . ,which-key-side-window-slot))))) + (which-key--debug-message "Allow imprecise fit: %s +Display window alist: %s" + which-key-allow-imprecise-window-fit + alist) ;; 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. commit 4e7739cdf879bb5be6ec871527be204c3e5eb063 Author: Justin Burkett Date: Sat Apr 13 15:56:34 2024 -0400 Add more debugging info to which-key--create-pages diff --git a/which-key.el b/which-key.el index 7d859a90bc6..beb111211a8 100644 --- a/which-key.el +++ b/which-key.el @@ -2124,11 +2124,36 @@ is the width of the live window." ;; `which-key-allow-imprecise-window-fit' is non-nil. (setf (which-key--pages-height result) which-key-min-display-lines)) (which-key--debug-message "Frame height: %s +Frame pixel width: %s +Frame char width: %s +Frame width: %s +Which-key initial width: %s +Which-key adjusted width: %s Minibuffer height: %s -Max dimensions: (%s,%s) -Available for bindings: (%s,%s) -Actual lines: %s" (frame-height) (window-text-height (minibuffer-window)) -max-lines max-width avl-lines avl-width (which-key--pages-height result)) +Max dimensions: (%s, %s) +Available for bindings: (%s, %s) +Popup type info: (%s, %s, %s) +Computed page widths: %s +Actual lines: %s" + (frame-height) + (frame-pixel-width) + (frame-char-width) + (window-total-width (frame-root-window)) + (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 + which-key-side-window-max-width)) + (window-text-height (minibuffer-window)) + max-lines + max-width + avl-lines + avl-width + which-key-popup-type + which-key-side-window-location + which-key-side-window-max-width + (which-key--pages-widths result) + (which-key--pages-height result)) result))) (defun which-key--lighter-status () commit c606abd083387d85e96dbc9b7ebde52f214407c6 Author: Jeremy Bryant Date: Mon Apr 8 23:11:08 2024 +0100 Add explicit binding to nil in let * which-key.el (which-key--match-replacement, which-key--propertize-key): Add explicit binding of case-fold-search to nil. diff --git a/which-key.el b/which-key.el index 660ff228019..7d859a90bc6 100644 --- a/which-key.el +++ b/which-key.el @@ -1551,7 +1551,7 @@ Within these categories order using `which-key-key-order'." (when (and (consp key-binding) (not (symbolp (car replacement)))) (let ((key-regexp (caar replacement)) (binding-regexp (cdar replacement)) - case-fold-search) + (case-fold-search nil)) (and (or (null key-regexp) (string-match-p key-regexp (car key-binding))) @@ -1684,7 +1684,7 @@ If KEY contains any \"special keys\" defined in (mapconcat #'identity which-key-special-keys "\\|") "\\)")) - case-fold-search) + (case-fold-search nil)) (save-match-data (if (and which-key-special-keys (string-match regexp key)) commit 672689aab8e6b68afa7961fbaa3beaded53b8991 Author: Jeremy Bryant Date: Sun Apr 7 19:30:00 2024 +0100 ; Simplify internal defun * which-key.el (which-key--rotate): Simplify code slightly. Co-authored-by: Philip Kaludercic diff --git a/which-key.el b/which-key.el index 0c38a1a1bc8..660ff228019 100644 --- a/which-key.el +++ b/which-key.el @@ -729,9 +729,8 @@ Used when `which-key-popup-type' is frame.") (defun which-key--rotate (list n) (let* ((len (length list)) - (n (if (< n 0) (+ len n) n)) - (n (mod n len))) - (append (last list (- len n)) (butlast list (- len n))))) + (n (- len (mod n len)))) + (append (last list n) (butlast list n)))) (defun which-key--pages-set-current-page (pages-obj n) (setf (which-key--pages-pages pages-obj) commit 8adbc25c390bb6c2b1359e17cca08fd90be6ba3e Author: Jeremy Bryant Date: Thu Apr 4 11:18:57 2024 +0100 Use null for clarity * which-key.el (which-key--show-evil-operator-keymap): Use null for clarity of zero length. diff --git a/which-key.el b/which-key.el index 8c6d4236b1d..0c38a1a1bc8 100644 --- a/which-key.el +++ b/which-key.el @@ -2659,7 +2659,7 @@ KEYMAP is selected interactively by mode in (let ((formatted-keys (which-key--get-bindings nil keymap #'which-key--evil-operator-filter))) - (cond ((= (length formatted-keys) 0) + (cond ((null formatted-keys) (message "which-key: Keymap empty")) ((listp which-key-side-window-location) (setq which-key--last-try-2-loc commit 2c9f94162c20e18bee23625047e9192525632811 Author: Jeremy Bryant Date: Wed Apr 3 22:43:19 2024 +0100 ; Use `memq' to be just as explicit as necessary * which-key.el (which-key--show-evil-operator-keymap): Use `memq' to be just as explicit as necessary. diff --git a/which-key.el b/which-key.el index 57825ca0e50..8c6d4236b1d 100644 --- a/which-key.el +++ b/which-key.el @@ -2672,7 +2672,7 @@ KEYMAP is selected interactively by mode in nil "evil operator/motion keys")) (which-key--show-page))))) (let ((key (read-key))) - (when (member key '(?f ?F ?t ?T ?`)) + (when (memq key '(?f ?F ?t ?T ?`)) ;; these keys trigger commands that read the next char manually (setq which-key--inhibit-next-operator-popup t)) (cond ((and which-key-use-C-h-commands (numberp key) (= key help-char)) commit 54b52f4c3c4fdc663c4f50c94d3b8a6eb0d857e7 Author: Jeremy Bryant Date: Wed Apr 3 21:16:03 2024 +0100 * which-key.el (which-key--show-evil-operator-keymap): let not let* diff --git a/which-key.el b/which-key.el index 8837eefd43c..57825ca0e50 100644 --- a/which-key.el +++ b/which-key.el @@ -2671,7 +2671,7 @@ KEYMAP is selected interactively by mode in formatted-keys nil "evil operator/motion keys")) (which-key--show-page))))) - (let* ((key (read-key))) + (let ((key (read-key))) (when (member key '(?f ?F ?t ?T ?`)) ;; these keys trigger commands that read the next char manually (setq which-key--inhibit-next-operator-popup t)) commit 62ebafeae751fe130d1ac27c55930385ccce2757 Author: Jeremy Bryant Date: Wed Apr 3 21:13:24 2024 +0100 * which-key.el (which-key--create-pages-1): Use cl-decf for clarity diff --git a/which-key.el b/which-key.el index decde2d10bd..8837eefd43c 100644 --- a/which-key.el +++ b/which-key.el @@ -2077,7 +2077,7 @@ should be minimized." ;; simple search for a fitting page (while (and (> available-lines min-lines) (not found)) - (setq available-lines (- available-lines 1) + (setq available-lines (cl-decf available-lines) prev-result result result (which-key--list-to-pages keys available-lines available-width) commit 94a29cda9f75c9901667bf45ff25bd8c892cb416 Author: Jeremy Bryant Date: Wed Apr 3 21:05:09 2024 +0100 * which-key.el (which-key--partition-list): Replace cl-subseq by take diff --git a/which-key.el b/which-key.el index bf45386f578..decde2d10bd 100644 --- a/which-key.el +++ b/which-key.el @@ -2013,7 +2013,7 @@ that width." "Partition LIST into N-sized sublists." (let (res) (while list - (setq res (cons (cl-subseq list 0 (min n (length list))) res) + (setq res (cons (take (min n (length list)) list) res) list (nthcdr n list))) (nreverse res))) commit aceafc88e68c178d7387d625297fe4f92b0c13d7 Author: Jeremy Bryant Date: Tue Apr 2 21:54:40 2024 +0100 Change cl-case to cl-ecase * which-key.el (which-key--popup-max-dimensions): Change cl-case to cl-ecase to signal error if needed. diff --git a/which-key.el b/which-key.el index d4efa3ede75..bf45386f578 100644 --- a/which-key.el +++ b/which-key.el @@ -1366,7 +1366,7 @@ Dimension 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 + (cl-ecase which-key-popup-type (minibuffer (which-key--minibuffer-max-dimensions)) (side-window (which-key--side-window-max-dimensions)) (frame (which-key--frame-max-dimensions)) commit c9c3eafafadbeab0bf21e0a3d6ab9718d20af877 Author: Jeremy Bryant Date: Tue Apr 2 21:54:02 2024 +0100 * which-key.el (which-key--popup-max-dimensions): Fix docstring typo diff --git a/which-key.el b/which-key.el index 820875bfdaf..d4efa3ede75 100644 --- a/which-key.el +++ b/which-key.el @@ -1362,7 +1362,7 @@ call signature in different emacs versions" (defun which-key--popup-max-dimensions () "Return maximum dimension available for popup. -Dimesion functions should return the maximum possible (height +Dimension 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." commit f25457c270fd8890f992e02b8ead8db9a3c9cfe2 Author: Jeremy Bryant Date: Mon Apr 1 16:39:49 2024 +0100 Replace wholenump by natnump for context readability * which-key.el (which-key--width-or-percentage-to-width, which-key--height-or-percentage-to-height): Use natnump instead of wholenump. diff --git a/which-key.el b/which-key.el index 781fee9683c..820875bfdaf 100644 --- a/which-key.el +++ b/which-key.el @@ -1170,7 +1170,7 @@ 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) + (if (natnump width-or-percentage) width-or-percentage (round (* width-or-percentage (window-total-width (frame-root-window)))))) @@ -1180,7 +1180,7 @@ 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) + (if (natnump height-or-percentage) height-or-percentage (round (* height-or-percentage (window-total-height (frame-root-window)))))) commit bf9ceab0bea07afd9a5a661d9e7a043cb96daf84 Author: Jeremy Bryant Date: Mon Apr 1 16:33:26 2024 +0100 ; which-key.el: Display mode in error message * which-key.el (which-key-add-major-mode-key-based-replacements): Display mode in error message diff --git a/which-key.el b/which-key.el index f2f86269fc1..781fee9683c 100644 --- a/which-key.el +++ b/which-key.el @@ -1085,7 +1085,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (declare (indent defun)) ;; TODO: Make interactive (when (not (symbolp mode)) - (error "MODE should be a symbol corresponding to a value of major-mode")) + (error "`%S' should be a symbol corresponding to a value of major-mode" mode)) (let ((mode-alist (or (cdr-safe (assq mode which-key-replacement-alist)) (list))) (title-mode-alist commit bfab035d1b9552c2239203644cb4535c5ef4b45b Author: Jeremy Bryant Date: Mon Mar 18 23:18:30 2024 +0000 Simplify code to use null * which-key.el (which-key--create-buffer-and-show): Use null. diff --git a/which-key.el b/which-key.el index 2f2c2804f55..f2f86269fc1 100644 --- a/which-key.el +++ b/which-key.el @@ -2692,7 +2692,7 @@ Finally, show the buffer." (formatted-keys (which-key--get-bindings prefix-keys from-keymap filter)) (prefix-desc (key-description prefix-keys))) - (cond ((= (length formatted-keys) 0) + (cond ((null formatted-keys) (message "%s- which-key: There are no keys to show" prefix-desc)) ((listp which-key-side-window-location) (setq which-key--last-try-2-loc commit 681001bf697be06a4801e6ef1083fbf6d4a1b8ec Author: Jeremy Bryant Date: Tue Mar 12 22:34:03 2024 +0000 ; Change defcustom types to natnum * which-key.el (which-key-frame-max-width, which-key-frame-max-height): Change defcustom type integer to natnum. diff --git a/which-key.el b/which-key.el index 29e0b5a277c..2f2c2804f55 100644 --- a/which-key.el +++ b/which-key.el @@ -326,12 +326,12 @@ a percentage out of the frame's height." (defcustom which-key-frame-max-width 60 "Maximum width of which-key popup when type is frame." - :type 'integer + :type 'natnum :version "1.0") (defcustom which-key-frame-max-height 20 "Maximum height of which-key popup when type is frame." - :type 'integer + :type 'natnum :version "1.0") (defcustom which-key-allow-imprecise-window-fit (not (display-graphic-p)) commit 5111e377a2ae9881545710a9331f6788a26cdcbd Author: Stefan Monnier Date: Wed Mar 27 21:43:29 2024 -0400 Fix labeling of functions in which-key popup Add a few minor changes. diff --git a/which-key.el b/which-key.el index a91ff7eb501..29e0b5a277c 100644 --- a/which-key.el +++ b/which-key.el @@ -127,7 +127,7 @@ of the which-key popup." (defcustom which-key-dont-use-unicode nil "If non-nil, don't use any unicode characters in default setup. For affected settings, see `which-key-replacement-alist', `which-key-ellipsis' -'which-key-separator'." +`which-key-separator'." :type 'boolean :version "1.0") @@ -794,11 +794,11 @@ should be formatted as an input for `kbd'." (setq this-command-keys (this-single-command-raw-keys))) this-command-keys)) -(defcustom which-key-this-command-keys-function 'which-key--this-command-keys +(defcustom which-key-this-command-keys-function #'which-key--this-command-keys "Function used to retrieve current key sequence. The purpose of allowing this variable to be customized is to allow which-key to support packages that insert non-standard -'keys' into the key sequence being read by emacs." +`keys' into the key sequence being read by emacs." :group 'which-key :type 'function :version "1.0") @@ -832,7 +832,7 @@ invalid keys." (bound-and-true-p evil-this-operator))) (add-hook 'which-key-inhibit-display-hook - 'which-key-evil-this-operator-p) + #'which-key-evil-this-operator-p) ;;;; God-mode @@ -875,16 +875,16 @@ disable support." (progn (advice-remove 'god-mode-lookup-command #'which-key--god-mode-lookup-command-advice) - (setq which-key-this-command-keys-function - 'which-key--this-command-keys) + (remove-function which-key-this-command-keys-function + #'which-key--god-mode-this-command-keys) (remove-hook 'which-key-inhibit-display-hook - 'which-key-god-mode-self-insert-p)) + #'which-key-god-mode-self-insert-p)) (advice-add 'god-mode-lookup-command :around #'which-key--god-mode-lookup-command-advice) - (setq which-key-this-command-keys-function - 'which-key--god-mode-this-command-keys) + (add-function :override which-key-this-command-keys-function + #'which-key--god-mode-this-command-keys) (add-hook 'which-key-inhibit-display-hook - 'which-key-god-mode-self-insert-p))) + #'which-key-god-mode-self-insert-p))) ;;; Mode @@ -1849,11 +1849,10 @@ alists. Returns a list (key separator description)." (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 binding))) - (copy-sequence (symbol-name remap)) - (copy-sequence (symbol-name binding))))) + (copy-sequence (symbol-name + (or (and which-key-compute-remaps + (command-remapping binding)) + binding)))) (defun which-key--get-menu-item-binding (def) "Retrieve binding for menu-item" @@ -1898,8 +1897,11 @@ Requires `which-key-compute-remaps' to be non-nil." (cond ((symbolp def) (which-key--compute-binding def)) ((keymapp def) "prefix") - ((eq 'lambda (car-safe def)) "lambda") - ((eq 'closure (car-safe def)) "closure") + ((functionp def) + (cond + ((eq 'lambda (car-safe def)) "lambda") + ((eq 'closure (car-safe def)) "closure") + (t "function"))) ((stringp def) def) ((vectorp def) (key-description def)) ((and (consp def) commit 96911a1d3faf8426a33241f4821319e98421f380 Merge: afcea611a87 73a12d2f4c4 Author: Justin Burkett Date: Tue Mar 12 16:33:50 2024 -0400 Merge remote-tracking branch 'origin/master' commit afcea611a872cb76e6af6013ea02722204a97eed Author: Jeremy Bryant Date: Sun Mar 10 22:45:14 2024 +0000 * which-key.el (which-key--create-pages): Untabify. diff --git a/which-key.el b/which-key.el index fcdaec4a176..5a3d9386f1d 100644 --- a/which-key.el +++ b/which-key.el @@ -2101,7 +2101,7 @@ is the width of the live window." (avl-width (if prefix (- max-width prefix) max-width)) (vertical (or (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right))) - (eq which-key-max-display-columns 1))) + (eq which-key-max-display-columns 1))) result) (setq result (which-key--create-pages-1 @@ -2114,7 +2114,7 @@ is the width of the live window." (which-key--maybe-get-prefix-title (key-description prefix-keys)))) (when prefix-top-bottom - ;; Add back the line earlier reserved for the page information. + ;; Add back the line earlier reserved for the page information. (setf (which-key--pages-height result) max-lines)) (when (and (= (which-key--pages-num-pages result) 1) (> which-key-min-display-lines commit 1f55b85887050b0b2a84466dc001d81471b13343 Author: Jeremy Bryant Date: Sun Mar 10 22:40:47 2024 +0000 * which-key.el (which-key--pad-column): Untabify. diff --git a/which-key.el b/which-key.el index dcb5af7ce7d..fcdaec4a176 100644 --- a/which-key.el +++ b/which-key.el @@ -1996,17 +1996,17 @@ 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)) - (avl-width (- avl-width col-key-width col-sep-width)) + (avl-width (- avl-width col-key-width col-sep-width)) (col-desc-width (min avl-width - (which-key--max-len + (which-key--max-len col-keys 2 - which-key-min-column-description-width))) + which-key-min-column-description-width))) (col-width (+ col-key-width col-sep-width col-desc-width)) - (col-format (concat "%" (int-to-string col-key-width) + (col-format (concat "%" (int-to-string col-key-width) "s%s%-" (int-to-string col-desc-width) "s"))) (cons col-width (mapcar (lambda (k) (apply #'format col-format k)) - col-keys)))) + col-keys)))) (defun which-key--partition-list (n list) "Partition LIST into N-sized sublists." commit af8a760ad2d54bd1f1513804e67a59ac03cd1eb5 Author: Jeremy Bryant Date: Sat Mar 9 22:08:57 2024 +0000 ; * which-key.el (which-key--get-keymap-bindings-1): Use eql. diff --git a/which-key.el b/which-key.el index 54ec92d2311..dcb5af7ce7d 100644 --- a/which-key.el +++ b/which-key.el @@ -1886,7 +1886,7 @@ Requires `which-key-compute-remaps' to be non-nil." (or all ;; event 27 is escape, so this will pick up meta ;; bindings and hopefully not too much more - (and (numberp ev) (= ev 27)))) + (eql ev 27))) (setq bindings (which-key--get-keymap-bindings-1 keymap bindings key nil all ignore-commands))) commit 61f6c3ed721017e28ed2e80e1ebebf5d8fc0c3d5 Author: Jeremy Bryant Date: Sat Mar 9 21:59:43 2024 +0000 ; * which-key.el (which-key--truncate-description): Untabify. diff --git a/which-key.el b/which-key.el index 985c419f73b..54ec92d2311 100644 --- a/which-key.el +++ b/which-key.el @@ -1701,20 +1701,20 @@ If KEY contains any \"special keys\" defined in (defsubst which-key--truncate-description (desc avl-width) "Truncate DESC description to `which-key-max-description-length'." (let* ((max which-key-max-description-length) - (max (cl-etypecase max - (null nil) - (integer max) - (float (truncate (* max avl-width))) - (function (let ((val (funcall max avl-width))) - (if (floatp val) (truncate val) val)))))) + (max (cl-etypecase max + (null nil) + (integer max) + (float (truncate (* max avl-width))) + (function (let ((val (funcall max avl-width))) + (if (floatp val) (truncate val) val)))))) (if (and max (> (length desc) max)) (let ((dots (and (not (equal which-key-ellipsis "")) - (which-key--propertize - which-key-ellipsis 'face - (get-text-property (1- (length desc)) 'face desc))))) - (if dots + (which-key--propertize + which-key-ellipsis 'face + (get-text-property (1- (length desc)) 'face desc))))) + (if dots (concat (substring desc 0 (- max (length dots))) dots) - (substring desc 0 max))) + (substring desc 0 max))) desc))) (defun which-key--highlight-face (description) commit 83bb45e16734b26f67122e51dda1ea3671a7928b Author: Jeremy Bryant Date: Sat Mar 9 21:54:23 2024 +0000 Use string-empty-p for readability. * which-key.el (which-key--maybe-get-prefix-title): Use string-empty-p for readability. diff --git a/which-key.el b/which-key.el index a4aec2476d3..985c419f73b 100644 --- a/which-key.el +++ b/which-key.el @@ -1660,7 +1660,7 @@ no title exists." (alternate (when (and binding (symbolp binding)) (symbol-name binding)))) (cond (title-res title-res) - ((not (string-equal repl-res "")) repl-res) + ((not (string-empty-p repl-res)) repl-res) ((and (eq which-key-show-prefix 'echo) alternate) alternate) ((and (member which-key-show-prefix '(bottom top mode-line)) commit 33d6ce3324ce481411c3b66cf37b931e4daa3d8c Author: Jeremy Bryant Date: Fri Mar 8 23:25:59 2024 +0000 Don't quote t * which-key.el (which-key--replace-in-repl-list-many): Don't quote t. diff --git a/which-key.el b/which-key.el index 4a0b8b8e045..a4aec2476d3 100644 --- a/which-key.el +++ b/which-key.el @@ -1588,7 +1588,7 @@ Within these categories order using `which-key-key-order'." (let (found) (dolist (repl repls) (when (which-key--match-replacement key-binding repl) - (setq found 't) + (setq found t) (setq key-binding (which-key--replace-in-binding key-binding repl)))) (when found `(replaced . ,key-binding)))) commit 6e035b5e2f7c94d39fe4a6765c6c52258bcf14d5 Author: Jeremy Bryant Date: Fri Mar 8 23:20:07 2024 +0000 Use declare form instead of put for clarity * which-key.el (which-key-add-keymap-based-replacements): Use declare form instead of put property. diff --git a/which-key.el b/which-key.el index af4bc6cb337..4a0b8b8e045 100644 --- a/which-key.el +++ b/which-key.el @@ -1023,6 +1023,7 @@ prefix. An example is For backwards compatibility, REPLACEMENT can also be a string, but the above format is preferred, and the option to use a string for REPLACEMENT will eventually be removed." + (declare (indent defun)) (while key (let ((def (cond @@ -1036,7 +1037,6 @@ for REPLACEMENT will eventually be removed." (define-key keymap (kbd key) def)) (setq key (pop more) replacement (pop more)))) -(put 'which-key-add-keymap-based-replacements 'lisp-indent-function 'defun) ;;;###autoload (defun which-key-add-key-based-replacements commit 73a12d2f4c447dc78abce46192cd527aa04340c5 Merge: daae57ea192 8ade3298d94 Author: Justin Burkett Date: Thu Mar 7 19:24:22 2024 -0500 Merge pull request #367 from tarsiiformes/long-gone commit 8ade3298d945f9237b872a66988892e14fc55563 Author: Jonas Bernoulli Date: Fri Mar 8 01:13:09 2024 +0100 Remove reference to long gone which-key-manual-update * which-key.el (which-key--paging-functions): Remove reference to which-key-manual-update. This commands was remove in 42a25055163141165aa0269dbca69735e704825c. diff --git a/which-key.el b/which-key.el index af4bc6cb337..783156f7deb 100644 --- a/which-key.el +++ b/which-key.el @@ -487,7 +487,6 @@ This string is fed into `substitute-command-keys'") (defvar which-key--paging-functions (list #'which-key-C-h-dispatch - #'which-key-manual-update #'which-key-turn-page #'which-key-show-next-page-cycle #'which-key-show-next-page-no-cycle commit daae57ea192288329af7f82607f3495291637033 Author: Jeremy Bryant Date: Wed Mar 6 22:48:18 2024 +0000 Remove unnecessary eval-when-compile * which-key.el (which-key--ignore-non-evil-keys-regexp): Remove unnecessary eval-when-compile in regexp-opt. diff --git a/which-key.el b/which-key.el index 4088032f26e..af4bc6cb337 100644 --- a/which-key.el +++ b/which-key.el @@ -707,9 +707,8 @@ Used when `which-key-popup-type' is frame.") (defvar which-key--evil-keys-regexp (eval-when-compile (regexp-opt '("-state")))) (defvar which-key--ignore-non-evil-keys-regexp - (eval-when-compile - (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" - "select-window" "switch-frame" "which-key")))) + (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" + "select-window" "switch-frame" "which-key"))) (defvar which-key--ignore-keys-regexp (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" "select-window" "switch-frame" "-state" commit bb9fc431ec2123fc71fe297f7fb396222f5be26e Author: Jeremy Bryant Date: Tue Mar 5 22:40:57 2024 +0000 Replace internet link by Info node * which-key.el (which-key-hide-alt-key-translations): Replace internet link by Info node. diff --git a/which-key.el b/which-key.el index 7927c901fec..4088032f26e 100644 --- a/which-key.el +++ b/which-key.el @@ -504,7 +504,7 @@ This string is fed into `substitute-command-keys'") 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" +See Info node `(emacs)Modifier Keys'." :type 'boolean :version "1.0") commit b5b431089a11a51742b09471a2f43d229f5a4fb0 Author: Jeremy Bryant Date: Tue Mar 5 22:01:58 2024 +0000 ; Replace tabs by spaces * which-key.el (which-key--paging-functions): Replace tabs by spaces. diff --git a/which-key.el b/which-key.el index 27c4fa3a12c..7927c901fec 100644 --- a/which-key.el +++ b/which-key.el @@ -487,14 +487,14 @@ This string is fed into `substitute-command-keys'") (defvar which-key--paging-functions (list #'which-key-C-h-dispatch - #'which-key-manual-update - #'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)) + #'which-key-manual-update + #'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)) (defvar which-key-persistent-popup nil "Whether or not to disable `which-key--hide-popup'.") commit 0947af117679a49ee4d0db6c9ca5db3c3a0ff186 Author: Justin Burkett Date: Thu Mar 7 12:45:03 2024 -0500 Sharp quote which-key-sort-order default. diff --git a/which-key.el b/which-key.el index 40cb6ba99c1..27c4fa3a12c 100644 --- a/which-key.el +++ b/which-key.el @@ -350,7 +350,7 @@ and https://github.com/justbur/emacs-which-key/issues/225." (const :tag "No" nil)) :version "1.0") -(defcustom which-key-sort-order 'which-key-key-order +(defcustom which-key-sort-order #'which-key-key-order "Order in which the key bindings are sorted. If nil, do not resort the output from `describe-buffer-bindings' which groups by mode. Ordering options commit a79a8845a8d3229825077d29776630e7b3ac4e6c Author: Jeremy Bryant Date: Mon Mar 4 23:38:06 2024 +0000 Remove unnecessary :group attributes * which-key.el: Remove :group 'which-key in defcustoms. (which-key-idle-delay): (which-key-idle-secondary-delay): (which-key-echo-keystrokes): (which-key-max-description-length): (which-key-min-column-description-width): (which-key-add-column-padding): (which-key-unicode-correction): (which-key-dont-use-unicode): (which-key-separator): (which-key-ellipsis): (which-key-prefix-prefix): (which-key-compute-remaps): (which-key-replacement-alist): (which-key-allow-multiple-replacements): (which-key-show-docstrings): (which-key-highlighted-command-list): (which-key-special-keys): (which-key-buffer-name): (which-key-show-prefix): (which-key-popup-type): (which-key-min-display-lines): (which-key-max-display-columns): (which-key-side-window-location): (which-key-side-window-slot): (which-key-side-window-max-width): (which-key-side-window-max-height): (which-key-frame-max-width): (which-key-frame-max-height): (which-key-allow-imprecise-window-fit): (which-key-show-remaining-keys): (which-key-sort-order): (which-key-sort-uppercase-first): (which-key-paging-prefixes): (which-key-paging-key): (which-key-use-C-h-commands): (which-key-show-early-on-C-h): (which-key-is-verbose): (which-key-preserve-window-configuration): (which-key-hide-alt-key-translations): (which-key-delay-functions): (which-key-allow-regexps): (which-key-inhibit-regexps): (which-key-show-transient-maps): (which-key-init-buffer-hook): diff --git a/which-key.el b/which-key.el index 9623c729b92..40cb6ba99c1 100644 --- a/which-key.el +++ b/which-key.el @@ -61,7 +61,6 @@ This variable should be set before activating `which-key-mode'. 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 :version "1.0") @@ -70,7 +69,6 @@ recommended 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 '(choice float (const :tag "Disabled" nil)) :version "1.0") @@ -84,7 +82,6 @@ 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 :version "1.0") @@ -95,7 +92,6 @@ characters), a float (use that fraction of the available width), or a function, which takes one argument, the available width in characters, and whose return value has one of the types mentioned before. Truncation is done using `which-key-ellipsis'." - :group 'which-key :type '(choice (const :tag "Disable truncation" nil) (integer :tag "Width in characters") (float :tag "Use fraction of available width") @@ -104,13 +100,11 @@ before. Truncation is done using `which-key-ellipsis'." (defcustom which-key-min-column-description-width 0 "Every column should at least have this width." - :group 'which-key :type 'natnum :version "1.0") (defcustom which-key-add-column-padding 0 "Additional spaces to add to the left of each key column." - :group 'which-key :type 'integer :version "1.0") @@ -127,7 +121,6 @@ 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 characters get cutoff on the right side of the which-key popup." - :group 'which-key :type 'integer :version "1.0") @@ -135,7 +128,6 @@ of the which-key popup." "If non-nil, don't use any unicode characters in default setup. For affected settings, see `which-key-replacement-alist', `which-key-ellipsis' 'which-key-separator'." - :group 'which-key :type 'boolean :version "1.0") @@ -144,7 +136,6 @@ For affected settings, see `which-key-replacement-alist', `which-key-ellipsis' "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 :version "1.0") @@ -154,14 +145,12 @@ nil, in which case the default is \" : \"." Default is \"…\", unless `which-key-dont-use-unicode' is non nil, in which case the default is \"..\". This can also be the empty string to truncate without using any ellipsis." - :group 'which-key :type 'string :version "1.0") (defcustom which-key-prefix-prefix "+" "Prefix string to indicate a key bound to a keymap. Default is \"+\"." - :group 'which-key :type 'string :version "1.0") @@ -169,7 +158,6 @@ Default is \"+\"." "If non-nil, show remapped commands. This applies to commands that have been remapped given the currently active keymaps." - :group 'which-key :type 'boolean :version "1.0") @@ -211,7 +199,6 @@ 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 (const nil)) (choice regexp (const nil))) :value-type (cons (choice string (const nil)) @@ -224,7 +211,6 @@ When non-nil, this allows a single key binding to match multiple patterns in `which-key-replacement-alist'. When nil, only the first match is used to perform replacements from `which-key-replacement-alist'." - :group 'which-key :type 'boolean :version "1.0") @@ -235,7 +221,6 @@ break. If you set this variable to the symbol docstring-only, then the command's name with be omitted. You probably also want to adjust `which-key-max-description-length' at the same time if you use this feature." - :group 'which-key :type '(radio (const :tag "Do not show docstrings" nil) (const :tag "Add docstring to command names" t) @@ -249,7 +234,6 @@ 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))) :version "1.0") @@ -259,13 +243,11 @@ They also have `which-key-special-key-face' applied to them. This is disabled by default. An example configuration is \(setq which-key-special-keys \\='(\"SPC\" \"TAB\" \"RET\" \"ESC\" \"DEL\")\)" - :group 'which-key :type '(repeat string) :version "1.0") (defcustom which-key-buffer-name " *which-key*" "Name of which-key buffer." - :group 'which-key :type 'string :version "1.0") @@ -273,7 +255,6 @@ is disabled by default. An example configuration is "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) @@ -284,7 +265,6 @@ and nil. Nil turns the feature off." (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) @@ -293,14 +273,12 @@ and nil. Nil turns the feature off." (defcustom which-key-min-display-lines 1 "Minimum number of horizontal lines to display in the which-key buffer." - :group 'which-key :type 'integer :version "1.0") (defcustom which-key-max-display-columns nil "Maximum number of columns to display in the which-key buffer. A value of nil means don't impose a maximum." - :group 'which-key :type '(choice integer (const :tag "Unbounded" nil)) :version "1.0") @@ -310,7 +288,6 @@ 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) @@ -330,7 +307,6 @@ 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 :version "1.0") @@ -338,7 +314,6 @@ the right of) the middle slot. The default is zero." "Maximum width of which-key popup when type is side-window. 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 :version "1.0") @@ -346,19 +321,16 @@ it denotes a percentage out of the frame's width." "Maximum height of which-key popup when type is side-window. 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 :version "1.0") (defcustom which-key-frame-max-width 60 "Maximum width of which-key popup when type is frame." - :group 'which-key :type 'integer :version "1.0") (defcustom which-key-frame-max-height 20 "Maximum height of which-key popup when type is frame." - :group 'which-key :type 'integer :version "1.0") @@ -369,13 +341,11 @@ this on may help. See https://github.com/justbur/emacs-which-key/issues/130 and https://github.com/justbur/emacs-which-key/issues/225." - :group 'which-key :type 'boolean :version "1.0") (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)) :version "1.0") @@ -394,7 +364,6 @@ are 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) @@ -406,20 +375,17 @@ information." "If non-nil, uppercase comes before lowercase in sorting. This applies to the function chosen in `which-key-sort-order'. Otherwise, the order is reversed." - :group 'which-key :type 'boolean :version "1.0") (defcustom which-key-paging-prefixes '() "Enable paging for these prefixes." - :group 'which-key :type '(repeat string) :version "1.0") (defcustom which-key-paging-key "" "Key to use for changing pages. Bound after each of the prefixes in `which-key-paging-prefixes'" - :group 'which-key :type 'string :version "1.0") @@ -439,7 +405,6 @@ Bound after each of the prefixes in `which-key-paging-prefixes'" Normally `help-char' 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 :version "1.0") @@ -456,13 +421,11 @@ using C-h. Note that `which-key-idle-delay' should be set before turning on `which-key-mode'." - :group 'which-key :type 'boolean :version "1.0") (defcustom which-key-is-verbose nil "Whether to warn about potential mistakes in configuration." - :group 'which-key :type 'boolean :version "1.0") @@ -473,8 +436,6 @@ shown and restore it after which-key buffer is hidden. It prevents which-key from changing window position of visible buffers. Only takken into account when popup type is side-window." - :group - 'which-key :type 'boolean :version "1.0") @@ -544,7 +505,6 @@ 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 :version "1.0") @@ -561,7 +521,6 @@ 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) :version "1.0") @@ -570,7 +529,6 @@ The delay time is effectively added to the normal 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) :version "1.0") @@ -579,7 +537,6 @@ key sequences is what is produced by `key-description'." 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) :version "1.0") @@ -589,7 +546,6 @@ the key sequences is what is produced by `key-description'." 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 :version "1.0") @@ -601,7 +557,6 @@ it." ;; Hooks (defcustom which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized." - :group 'which-key :type 'hook :version "1.0") commit 9b33ccc293d215b36d375fc735ba5abda3332492 Author: Jeremy Bryant Date: Fri Mar 1 22:46:55 2024 +0000 Replace member by memq for clarity * which-key.el (which-key--side-window-max-dimensions): Replace member by memq. diff --git a/which-key.el b/which-key.el index c522f59a26b..9623c729b92 100644 --- a/which-key.el +++ b/which-key.el @@ -1448,7 +1448,7 @@ characters respectively." which-key-side-window-max-height)) ;; width (max 0 - (- (if (member which-key-side-window-location '(left right)) + (- (if (memq 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)) commit acaf5436576f8ad8fa736c93e6ee618b4b371d55 Author: Jeremy Bryant Date: Thu Feb 29 22:33:48 2024 +0000 Use declare form instead of put, for clarity * which-key.el (which-key-add-major-mode-key-based-replacements): Use declare form instead of put. diff --git a/which-key.el b/which-key.el index 3eb27be8f10..c522f59a26b 100644 --- a/which-key.el +++ b/which-key.el @@ -1129,6 +1129,7 @@ replacements are added to `which-key-replacement-alist'." 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." + (declare (indent defun)) ;; TODO: Make interactive (when (not (symbolp mode)) (error "MODE should be a symbol corresponding to a value of major-mode")) @@ -1155,8 +1156,6 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (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) (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. commit 85f17c0a4df0c94890b9e10af6ea402b24e20a3e Author: Jeremy Bryant Date: Thu Feb 29 21:47:50 2024 +0000 ; Use string-join to simplify and make meaning explicit * which-key.el (which-key--butlast-string): Replace mapconcat by string-join. diff --git a/which-key.el b/which-key.el index 8fdafbaaaba..3eb27be8f10 100644 --- a/which-key.el +++ b/which-key.el @@ -1592,7 +1592,7 @@ Within these categories order using `which-key-key-order'." (if (stringp maybe-string) (string-width maybe-string) 0)) (defsubst which-key--butlast-string (str) - (mapconcat #'identity (butlast (split-string str)) " ")) + (string-join (butlast (split-string str)) " ")) (defun which-key--match-replacement (key-binding replacement) ;; these are mode specific ones to ignore. The mode specific case is commit 0f5733b3ff72d1612220b0a8cab618992baf6df6 Author: Jeremy Bryant Date: Tue Feb 27 22:59:07 2024 +0000 Remove github reference in preparation for integration to Emacs core * which-key.el: Remove github reference. diff --git a/which-key.el b/which-key.el index dce9718c5b3..8fdafbaaaba 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,6 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett -;; URL: https://github.com/justbur/emacs-which-key ;; Version: 3.6.0 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit 19ed03715107082ebfd8c1c6be71944331f916d3 Author: Jeremy Bryant Date: Thu Feb 29 00:07:35 2024 +0000 Specify more precise customization type, natnum instead of integer * which-key.el (which-key-add-column-padding): Use natnum diff --git a/which-key.el b/which-key.el index 600f02f3f89..dce9718c5b3 100644 --- a/which-key.el +++ b/which-key.el @@ -106,7 +106,7 @@ before. Truncation is done using `which-key-ellipsis'." (defcustom which-key-min-column-description-width 0 "Every column should at least have this width." :group 'which-key - :type 'integer + :type 'natnum :version "1.0") (defcustom which-key-add-column-padding 0 commit d69ef9edaae3fc4ad9715e3ce99aa112253b0cdd Author: Jeremy Bryant Date: Sat Feb 24 11:58:49 2024 +0000 ; Add sharp-quotes to function names Replace quoted list by (list ...) where each element is sharp-quoted so that the byte-compiler can check if the functions exist. * which-key.el (which-key--paging-functions): Add sharp-quotes to function names. diff --git a/which-key.el b/which-key.el index a9087e2afc9..600f02f3f89 100644 --- a/which-key.el +++ b/which-key.el @@ -525,15 +525,16 @@ This string is fed into `substitute-command-keys'") map) "Keymap for C-h commands.") -(defvar which-key--paging-functions '(which-key-C-h-dispatch - which-key-manual-update - 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)) +(defvar which-key--paging-functions + (list #'which-key-C-h-dispatch + #'which-key-manual-update + #'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)) (defvar which-key-persistent-popup nil "Whether or not to disable `which-key--hide-popup'.") commit bc3c0c619f14f054a878c6e311eaf5ee1d39d471 Author: Jeremy Bryant Date: Sat Feb 24 12:38:45 2024 +0000 Remove unnecessary eval-when-compile from definition * which-key.el (which-key--ignore-keys-regexp): Remove eval-when-compile. diff --git a/which-key.el b/which-key.el index d07c9f9d62b..a9087e2afc9 100644 --- a/which-key.el +++ b/which-key.el @@ -756,10 +756,9 @@ Used when `which-key-popup-type' is frame.") (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" "select-window" "switch-frame" "which-key")))) (defvar which-key--ignore-keys-regexp - (eval-when-compile - (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" - "select-window" "switch-frame" "-state" - "which-key")))) + (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" + "select-window" "switch-frame" "-state" + "which-key"))) (defvar which-key--pages-obj nil) (cl-defstruct which-key--pages commit 5fbdf05351e77ee62e3933c7b5f46459693bd04c Author: Justin Burkett Date: Tue Feb 20 20:38:30 2024 -0500 Disentangle third party libraries (but keep support for now) Add `which-key-inhibit-display-hook' to allow third-party libraries to prevent which-key from displaying in certain circumstances. Add `which-key-this-command-keys-function' as a customizable variable to allow third-party libraries to teach which-key about custom symbols they insert into the key sequence. Add `which-key-evil-this-operator-p', `which-key-god-mode-self-insert-p' and `which-key--god-mode-this-command-keys' to provide support for god-mode and evil using the new mechanisms. diff --git a/which-key.el b/which-key.el index e4e5aaadde3..d07c9f9d62b 100644 --- a/which-key.el +++ b/which-key.el @@ -708,6 +708,15 @@ execution of a command, as in \(let \(\(which-key-inhibit t\)\) ...\)") +(defcustom which-key-inhibit-display-hook nil + "Hook run before display of which-key popup. +Each function in the hook is run before displaying the which-key +popup. If any function returns a non-nil value, the popup will +not display." + :group 'which-key + :type 'hook + :version "1.0") + (defvar which-key-keymap-history nil "History of keymap selections. Used in functions like `which-key-show-keymap'.") @@ -822,6 +831,27 @@ should be formatted as an input for `kbd'." result))))) ;;; Third-party library support + +(defun which-key--this-command-keys () + "Version of `this-single-command-keys' corrected for key-chords." + (let ((this-command-keys (this-single-command-keys))) + (when (and (vectorp this-command-keys) + (> (length this-command-keys) 0) + (eq (aref this-command-keys 0) 'key-chord) + (bound-and-true-p key-chord-mode)) + (setq this-command-keys (this-single-command-raw-keys))) + this-command-keys)) + +(defcustom which-key-this-command-keys-function 'which-key--this-command-keys + "Function used to retrieve current key sequence. +The purpose of allowing this variable to be customized is to +allow which-key to support packages that insert non-standard +'keys' into the key sequence being read by emacs." + :group 'which-key + :type 'function + :version "1.0") + + ;;;; Evil (defvar evil-state nil) @@ -845,6 +875,13 @@ invalid keys." :type 'boolean :version "1.0") +(defun which-key-evil-this-operator-p () + (and which-key-allow-evil-operators + (bound-and-true-p evil-this-operator))) + +(add-hook 'which-key-inhibit-display-hook + 'which-key-evil-this-operator-p) + ;;;; God-mode (defvar which-key--god-mode-support-enabled nil @@ -860,6 +897,21 @@ invalid keys." (when (bound-and-true-p which-key-mode) (which-key--hide-popup)))) +(defun which-key--god-mode-this-command-keys () + "Version of `this-single-command-keys' corrected for god-mode." + (let ((this-command-keys (this-single-command-keys))) + (when (and which-key--god-mode-support-enabled + (bound-and-true-p god-local-mode) + (eq this-command 'god-mode-self-insert)) + (setq this-command-keys (when which-key--god-mode-key-string + (kbd which-key--god-mode-key-string)))) + this-command-keys)) + +(defun which-key-god-mode-self-insert-p () + (and which-key--god-mode-support-enabled + (bound-and-true-p god-local-mode) + (eq this-command 'god-mode-self-insert))) + (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 @@ -868,10 +920,19 @@ disable support." (interactive "P") (setq which-key--god-mode-support-enabled (null disable)) (if disable - (advice-remove 'god-mode-lookup-command - #'which-key--god-mode-lookup-command-advice) + (progn + (advice-remove 'god-mode-lookup-command + #'which-key--god-mode-lookup-command-advice) + (setq which-key-this-command-keys-function + 'which-key--this-command-keys) + (remove-hook 'which-key-inhibit-display-hook + 'which-key-god-mode-self-insert-p)) (advice-add 'god-mode-lookup-command :around - #'which-key--god-mode-lookup-command-advice))) + #'which-key--god-mode-lookup-command-advice) + (setq which-key-this-command-keys-function + 'which-key--god-mode-this-command-keys) + (add-hook 'which-key-inhibit-display-hook + 'which-key-god-mode-self-insert-p))) ;;; Mode @@ -2471,7 +2532,8 @@ This command is always accessible (from any prefix) if which-key-show-early-on-C-h) (let ((current-prefix (butlast - (listify-key-sequence (which-key--this-command-keys))))) + (listify-key-sequence + (funcall which-key-this-command-keys-function))))) (which-key-reload-key-sequence current-prefix) (if which-key-idle-secondary-delay (which-key--start-timer which-key-idle-secondary-delay t) @@ -2692,24 +2754,9 @@ Finally, show the buffer." "On prefix \"%s\" which-key took %.0f ms." prefix-desc (* 1000 (float-time (time-since start-time)))))) -(defun which-key--this-command-keys () - "Version of `this-single-command-keys' corrected for key-chords and god-mode." - (let ((this-command-keys (this-single-command-keys))) - (when (and (vectorp this-command-keys) - (> (length this-command-keys) 0) - (eq (aref this-command-keys 0) 'key-chord) - (bound-and-true-p key-chord-mode)) - (setq this-command-keys (this-single-command-raw-keys))) - (when (and which-key--god-mode-support-enabled - (bound-and-true-p god-local-mode) - (eq this-command 'god-mode-self-insert)) - (setq this-command-keys (when which-key--god-mode-key-string - (kbd which-key--god-mode-key-string)))) - this-command-keys)) - (defun which-key--update () "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." - (let ((prefix-keys (which-key--this-command-keys)) + (let ((prefix-keys (funcall which-key-this-command-keys-function)) delay-time) (cond ((and (> (length prefix-keys) 0) (or (keymapp (key-binding prefix-keys)) @@ -2729,11 +2776,8 @@ Finally, show the buffer." 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)) + (or (run-hook-with-args-until-success + 'which-key-inhibit-display-hook) (null this-command)) (let ((max-dim (which-key--popup-max-dimensions))) (> (min (car-safe max-dim) (cdr-safe max-dim)) 0))) @@ -2793,7 +2837,7 @@ Finally, show the buffer." which-key--paging-functions)) (and (< 0 (length (this-single-command-keys))) (not (equal (which-key--current-prefix) - (which-key--this-command-keys))))) + (funcall which-key-this-command-keys-function))))) (cancel-timer which-key--paging-timer) (if which-key-idle-secondary-delay ;; we haven't executed a command yet so the secandary commit 673ae566ec483c8e2be4f076da9a54f5d905591a Author: Justin Burkett Date: Tue Feb 20 20:00:22 2024 -0500 Remove "Internal" from docstrings of defvars The internal status is implied by the double hyphen in the name. diff --git a/which-key.el b/which-key.el index 88cca1796a3..e4e5aaadde3 100644 --- a/which-key.el +++ b/which-key.el @@ -715,26 +715,24 @@ Used in functions like `which-key-show-keymap'.") ;;; Internal Vars (defvar which-key--buffer nil - "Internal: Holds reference to which-key buffer.") + "Holds reference to which-key buffer.") (defvar which-key--timer nil - "Internal: Holds reference to open window timer.") + "Holds reference to open window timer.") (defvar which-key--secondary-timer-active nil - "Internal: Non-nil if the secondary timer is active.") + "Non-nil if the secondary timer is active.") (defvar which-key--paging-timer nil - "Internal: Holds reference to timer for paging.") + "Holds reference to timer for paging.") (defvar which-key--frame nil - "Internal: Holds reference to which-key frame. + "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'.") + "Backup the initial value of `echo-keystrokes'.") (defvar which-key--prefix-help-cmd-backup nil - "Internal: Backup the value of `prefix-help-command'.") + "Backup the value of `prefix-help-command'.") (defvar which-key--last-try-2-loc nil - "Internal: Last location of side-window when two locations -used.") + "Last location of side-window when two locations used.") (defvar which-key--automatic-display nil - "Internal: Non-nil if popup was triggered with automatic -update.") + "Non-nil if popup was triggered with automatic update.") (defvar which-key--debug-buffer-name nil "If non-nil, use this buffer for debug messages.") (defvar which-key--multiple-locations nil) commit a192f73f596f91a67da726ad72f831318dc348d7 Author: Jeremy Bryant Date: Tue Feb 20 23:09:17 2024 +0000 Bump year to 2024 * which-key.el: Bump year diff --git a/which-key.el b/which-key.el index 2e3f6cb7f9c..88cca1796a3 100644 --- a/which-key.el +++ b/which-key.el @@ -1,6 +1,6 @@ ;;; which-key.el --- Display available keybindings in popup -*- lexical-binding: t; -*- -;; Copyright (C) 2017-2021 Free Software Foundation, Inc. +;; Copyright (C) 2017-2024 Free Software Foundation, Inc. ;; Author: Justin Burkett ;; Maintainer: Justin Burkett commit bb61e985778fe63fece1a8a3f79ba5f5f190d2b8 Author: Jeremy Bryant Date: Tue Feb 20 21:37:10 2024 +0000 Simplify test for empty list * which-key.el (which-key--show-keymap): Use (null) diff --git a/which-key.el b/which-key.el index 45301725704..2e3f6cb7f9c 100644 --- a/which-key.el +++ b/which-key.el @@ -2605,7 +2605,7 @@ KEYMAP is selected interactively by mode in (keymap-name keymap &optional prior-args all no-paging filter) (when prior-args (push prior-args which-key--prior-show-keymap-args)) (let ((bindings (which-key--get-bindings nil keymap filter all))) - (if (= (length bindings) 0) + (if (null bindings) (message "which-key: No bindings found in %s" keymap-name) (cond ((listp which-key-side-window-location) (setq which-key--last-try-2-loc commit 5fd89e57ff66e9eabb082e486d170d741eb6cde2 Author: Jeremy Bryant Date: Tue Feb 20 21:21:54 2024 +0000 Mention affected settings of which-key-dont-use-unicode * which-key.el (which-key-separator): Improve docstring diff --git a/which-key.el b/which-key.el index 0e6870aa8b8..45301725704 100644 --- a/which-key.el +++ b/which-key.el @@ -133,7 +133,9 @@ of the which-key popup." :version "1.0") (defcustom which-key-dont-use-unicode nil - "If non-nil, don't use any unicode characters in default setup." + "If non-nil, don't use any unicode characters in default setup. +For affected settings, see `which-key-replacement-alist', `which-key-ellipsis' +'which-key-separator'." :group 'which-key :type 'boolean :version "1.0") commit 5bffdf94d8a760a15e7c9bb8e12136fce127bdac Author: Jeremy Bryant Date: Mon Feb 19 23:41:28 2024 +0000 Add a :version tag to all defcustom's and defface's * which-key.el: add :version tag to all following (which-key-idle-delay): (which-key-idle-secondary-delay): (which-key-echo-keystrokes): (which-key-max-description-length): (which-key-min-column-description-width): (which-key-add-column-padding): (which-key-unicode-correction): (which-key-dont-use-unicode): (which-key-separator): (which-key-ellipsis): (which-key-prefix-prefix): (which-key-compute-remaps): (which-key-replacement-alist): (which-key-allow-multiple-replacements): (which-key-show-docstrings): (which-key-highlighted-command-list): (which-key-special-keys): (which-key-buffer-name): (which-key-show-prefix): (which-key-popup-type): (which-key-min-display-lines): (which-key-max-display-columns): (which-key-side-window-location): (which-key-side-window-slot): (which-key-side-window-max-width): (which-key-side-window-max-height): (which-key-frame-max-width): (which-key-frame-max-height): (which-key-allow-imprecise-window-fit): (which-key-show-remaining-keys): (which-key-sort-order): (which-key-sort-uppercase-first): (which-key-paging-prefixes): (which-key-paging-key): (which-key-use-C-h-commands): (which-key-show-early-on-C-h): (which-key-is-verbose): (which-key-preserve-window-configuration): (which-key-hide-alt-key-translations): (which-key-delay-functions): (which-key-allow-regexps): (which-key-inhibit-regexps): (which-key-show-transient-maps): (which-key-init-buffer-hook): (which-key-key-face): (which-key-separator-face): (which-key-note-face): (which-key-command-description-face): (which-key-local-map-description-face): (which-key-highlighted-command-face): (which-key-group-description-face): (which-key-special-key-face): (which-key-docstring-face): (which-key-custom-popup-max-dimensions-function): (which-key-custom-hide-popup-function): (which-key-custom-show-popup-function): (which-key-lighter): (which-key-allow-evil-operators): (which-key-show-operator-state-maps): diff --git a/which-key.el b/which-key.el index cf0c723f4fe..0e6870aa8b8 100644 --- a/which-key.el +++ b/which-key.el @@ -63,7 +63,8 @@ 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) + :type 'float + :version "1.0") (defcustom which-key-idle-secondary-delay nil "Seconds to wait for which-key to pop up after initial display. @@ -71,7 +72,8 @@ 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 '(choice float (const :tag "Disabled" nil))) + :type '(choice float (const :tag "Disabled" nil)) + :version "1.0") (defcustom which-key-echo-keystrokes (if (and echo-keystrokes (> (+ echo-keystrokes 0.01) @@ -84,7 +86,8 @@ This only applies if `which-key-popup-type' is minibuffer or `which-key-idle-delay' or else the keystroke echo will erase the which-key popup." :group 'which-key - :type 'float) + :type 'float + :version "1.0") (defcustom which-key-max-description-length 27 "Truncate the description of keys to this length. @@ -97,17 +100,20 @@ before. Truncation is done using `which-key-ellipsis'." :type '(choice (const :tag "Disable truncation" nil) (integer :tag "Width in characters") (float :tag "Use fraction of available width") - function)) + function) + :version "1.0") (defcustom which-key-min-column-description-width 0 "Every column should at least have this width." :group 'which-key - :type 'integer) + :type 'integer + :version "1.0") (defcustom which-key-add-column-padding 0 "Additional spaces to add to the left of each key column." :group 'which-key - :type 'integer) + :type 'integer + :version "1.0") (defcustom which-key-unicode-correction 3 "Correction for wide unicode characters. @@ -123,12 +129,14 @@ additional ASCII character in the which-key buffer. Increase this number if you are seeing characters get cutoff on the right side of the which-key popup." :group 'which-key - :type 'integer) + :type 'integer + :version "1.0") (defcustom which-key-dont-use-unicode nil "If non-nil, don't use any unicode characters in default setup." :group 'which-key - :type 'boolean) + :type 'boolean + :version "1.0") (defcustom which-key-separator (if which-key-dont-use-unicode " : " " → ") @@ -136,7 +144,8 @@ of the which-key popup." Default is \" → \", unless `which-key-dont-use-unicode' is non nil, in which case the default is \" : \"." :group 'which-key - :type 'string) + :type 'string + :version "1.0") (defcustom which-key-ellipsis (if which-key-dont-use-unicode ".." "…") @@ -145,20 +154,23 @@ Default is \"…\", unless `which-key-dont-use-unicode' is non nil, in which case the default is \"..\". This can also be the empty string to truncate without using any ellipsis." :group 'which-key - :type 'string) + :type 'string + :version "1.0") (defcustom which-key-prefix-prefix "+" "Prefix string to indicate a key bound to a keymap. Default is \"+\"." :group 'which-key - :type 'string) + :type 'string + :version "1.0") (defcustom which-key-compute-remaps nil "If non-nil, show remapped commands. This applies to commands that have been remapped given the currently active keymaps." :group 'which-key - :type 'boolean) + :type 'boolean + :version "1.0") (defcustom which-key-replacement-alist (delq nil @@ -202,7 +214,8 @@ non-nil value." :type '(alist :key-type (cons (choice regexp (const nil)) (choice regexp (const nil))) :value-type (cons (choice string (const nil)) - (choice string (const nil))))) + (choice string (const nil)))) + :version "1.0") (defcustom which-key-allow-multiple-replacements nil "Allow a key binding to be modified by multiple elements. @@ -211,7 +224,8 @@ patterns in `which-key-replacement-alist'. When nil, only the first match is used to perform replacements from `which-key-replacement-alist'." :group 'which-key - :type 'boolean) + :type 'boolean + :version "1.0") (defcustom which-key-show-docstrings nil "If non-nil, show each command's docstring in the which-key popup. @@ -224,7 +238,8 @@ you use this feature." :type '(radio (const :tag "Do not show docstrings" nil) (const :tag "Add docstring to command names" t) - (const :tag "Replace command name with docstring" docstring-only))) + (const :tag "Replace command name with docstring" docstring-only)) + :version "1.0") (defcustom which-key-highlighted-command-list '() "Rules used to highlight certain commands. @@ -234,7 +249,8 @@ matching command names and use 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)))) + :type '(repeat (choice string (cons regexp face))) + :version "1.0") (defcustom which-key-special-keys '() "These keys will automatically be truncated to one character. @@ -243,12 +259,14 @@ is disabled by default. An example configuration is \(setq which-key-special-keys \\='(\"SPC\" \"TAB\" \"RET\" \"ESC\" \"DEL\")\)" :group 'which-key - :type '(repeat string)) + :type '(repeat string) + :version "1.0") (defcustom which-key-buffer-name " *which-key*" "Name of which-key buffer." :group 'which-key - :type 'string) + :type 'string + :version "1.0") (defcustom which-key-show-prefix 'echo "Whether to and where to display the current prefix sequence. @@ -260,7 +278,8 @@ and nil. Nil turns the feature off." (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))) + (const :tag "Hide" nil)) + :version "1.0") (defcustom which-key-popup-type 'side-window "Supported types are minibuffer, side-window, frame, and custom." @@ -268,18 +287,21 @@ and nil. Nil turns the feature off." :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))) + (const :tag "Use your custom display functions" custom)) + :version "1.0") (defcustom which-key-min-display-lines 1 "Minimum number of horizontal lines to display in the which-key buffer." :group 'which-key - :type 'integer) + :type 'integer + :version "1.0") (defcustom which-key-max-display-columns nil "Maximum number of columns to display in the which-key buffer. A value of nil means don't impose a maximum." :group 'which-key - :type '(choice integer (const :tag "Unbounded" nil))) + :type '(choice integer (const :tag "Unbounded" nil)) + :version "1.0") (defcustom which-key-side-window-location 'bottom "Location of which-key popup when `which-key-popup-type' is side-window. @@ -293,7 +315,8 @@ location is tried." (const left) (const top) (const (right bottom)) - (const (bottom right)))) + (const (bottom right))) + :version "1.0") (defcustom which-key-side-window-slot 0 "The `slot' to use for `display-buffer-in-side-window'. @@ -307,31 +330,36 @@ 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) + :type 'integer + :version "1.0") (defcustom which-key-side-window-max-width 0.333 "Maximum width of which-key popup when type is side-window. 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) + :type 'float + :version "1.0") (defcustom which-key-side-window-max-height 0.25 "Maximum height of which-key popup when type is side-window. 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) + :type 'float + :version "1.0") (defcustom which-key-frame-max-width 60 "Maximum width of which-key popup when type is frame." :group 'which-key - :type 'integer) + :type 'integer + :version "1.0") (defcustom which-key-frame-max-height 20 "Maximum height of which-key popup when type is frame." :group 'which-key - :type 'integer) + :type 'integer + :version "1.0") (defcustom which-key-allow-imprecise-window-fit (not (display-graphic-p)) "Allow which-key to use a simpler method for resizing the popup. @@ -341,13 +369,15 @@ this on may help. See https://github.com/justbur/emacs-which-key/issues/130 and https://github.com/justbur/emacs-which-key/issues/225." :group 'which-key - :type 'boolean) + :type 'boolean + :version "1.0") (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))) + (const :tag "No" nil)) + :version "1.0") (defcustom which-key-sort-order 'which-key-key-order "Order in which the key bindings are sorted. @@ -368,25 +398,29 @@ information." (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))) + (function-item which-key-local-then-key-order)) + :version "1.0") (defcustom which-key-sort-uppercase-first t "If non-nil, uppercase comes before lowercase in sorting. This applies to the function chosen in `which-key-sort-order'. Otherwise, the order is reversed." :group 'which-key - :type 'boolean) + :type 'boolean + :version "1.0") (defcustom which-key-paging-prefixes '() "Enable paging for these prefixes." :group 'which-key - :type '(repeat string)) + :type '(repeat string) + :version "1.0") (defcustom which-key-paging-key "" "Key to use for changing pages. Bound after each of the prefixes in `which-key-paging-prefixes'" :group 'which-key - :type 'string) + :type 'string + :version "1.0") ;; (defcustom which-key-undo-key nil ;; "Key (string) to use for undoing keypresses. Bound recursively @@ -405,7 +439,8 @@ Normally `help-char' 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) + :type 'boolean + :version "1.0") (defcustom which-key-show-early-on-C-h nil "Allow C-h (`help-char') to trigger which-key popup before timer. @@ -421,12 +456,14 @@ using C-h. Note that `which-key-idle-delay' should be set before turning on `which-key-mode'." :group 'which-key - :type 'boolean) + :type 'boolean + :version "1.0") (defcustom which-key-is-verbose nil "Whether to warn about potential mistakes in configuration." :group 'which-key - :type 'boolean) + :type 'boolean + :version "1.0") (defcustom which-key-preserve-window-configuration nil "Save and restore window configuration around which-key popup display. @@ -437,7 +474,8 @@ buffers. Only takken into account when popup type is side-window." :group 'which-key - :type 'boolean) + :type 'boolean + :version "1.0") (defvar which-key-C-h-map-prompt (concat " \\" @@ -505,7 +543,8 @@ 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) + :type 'boolean + :version "1.0") (defcustom which-key-delay-functions nil "List of functions that may delay the which-key popup. @@ -521,7 +560,8 @@ 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)) + :type '(repeat function) + :version "1.0") (defcustom which-key-allow-regexps nil "A list of regexp strings to use to filter key sequences. @@ -529,7 +569,8 @@ 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)) + :type '(repeat regexp) + :version "1.0") (defcustom which-key-inhibit-regexps nil "A list of regexp strings to use to filter key sequences. @@ -537,7 +578,8 @@ 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)) + :type '(repeat regexp) + :version "1.0") (defcustom which-key-show-transient-maps nil "Show keymaps created by `set-transient-map' when applicable. @@ -546,7 +588,8 @@ 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) + :type 'boolean + :version "1.0") (make-obsolete-variable 'which-key-enable-extended-define-key @@ -557,7 +600,8 @@ it." (defcustom which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized." :group 'which-key - :type 'hook) + :type 'hook + :version "1.0") ;;;; Faces @@ -569,48 +613,57 @@ it." (defface which-key-key-face '((t . (:inherit font-lock-constant-face))) "Face for which-key keys" - :group 'which-key-faces) + :group 'which-key-faces + :version "1.0") (defface which-key-separator-face '((t . (:inherit font-lock-comment-face))) "Face for the separator (default separator is an arrow)" - :group 'which-key-faces) + :group 'which-key-faces + :version "1.0") (defface which-key-note-face '((t . (:inherit which-key-separator-face))) "Face for notes or hints occasionally provided" - :group 'which-key-faces) + :group 'which-key-faces + :version "1.0") (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) + :group 'which-key-faces + :version "1.0") (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) + :group 'which-key-faces + :version "1.0") (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) + :group 'which-key-faces + :version "1.0") (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) + :group 'which-key-faces + :version "1.0") (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) + :group 'which-key-faces + :version "1.0") (defface which-key-docstring-face '((t . (:inherit which-key-note-face))) "Face for docstrings." - :group 'which-key-faces) + :group 'which-key-faces + :version "1.0") ;;;; Custom popup @@ -620,13 +673,15 @@ 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 '(choice function (const nil))) + :type '(choice function (const nil)) + :version "1.0") (defcustom which-key-custom-hide-popup-function nil "Set a custom hide-popup function. It takes no arguments and the return value is ignored." :group 'which-key - :type '(choice function (const nil))) + :type '(choice function (const nil)) + :version "1.0") (defcustom which-key-custom-show-popup-function nil "Set a custom show-popup function. @@ -634,12 +689,14 @@ 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 '(choice function (const nil))) + :type '(choice function (const nil)) + :version "1.0") (defcustom which-key-lighter " WK" "Minor mode lighter to use in the mode-line." :group 'which-key - :type 'string) + :type 'string + :version "1.0") (defvar which-key-inhibit nil "Prevent which-key from popping up momentarily. @@ -775,7 +832,8 @@ 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) + :type 'boolean + :version "1.0") (defcustom which-key-show-operator-state-maps nil "Show the keys following an evil command that reads a motion. @@ -784,7 +842,8 @@ 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) + :type 'boolean + :version "1.0") ;;;; God-mode commit f2eae30c62a347dade351c9d39a34258b9fd094d Author: Justin Burkett Date: Thu Feb 8 21:36:45 2024 -0500 Format first sentences of docstrings. Ensure a complete sentence (at least a phrase with a period at the end) that fits on one line. diff --git a/which-key.el b/which-key.el index 4a19d1622f6..cf0c723f4fe 100644 --- a/which-key.el +++ b/which-key.el @@ -66,11 +66,10 @@ recommended :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." + "Seconds to wait for which-key to pop up after initial display. +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 '(choice float (const :tag "Disabled" nil))) @@ -106,8 +105,7 @@ before. Truncation is done using `which-key-ellipsis'." :type 'integer) (defcustom which-key-add-column-padding 0 - "Additional padding (number of spaces) to add to the left of -each key column." + "Additional spaces to add to the left of each key column." :group 'which-key :type 'integer) @@ -134,9 +132,9 @@ of the which-key popup." (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 \" : \"." + "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) @@ -150,14 +148,15 @@ string to truncate without using any ellipsis." :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 \"+\"." + "Prefix string to indicate a key bound to a keymap. +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." + "If non-nil, show remapped commands. +This applies to commands that have been remapped given the +currently active keymaps." :group 'which-key :type 'boolean) @@ -168,9 +167,8 @@ remapped given the currently active keymaps." '((("") . ("←")) (("") . ("→")))) (("<\\([[:alnum:]-]+\\)>") . ("\\1")))) - "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 + "ALIST for manipulating display of binding descriptions. +Each element of the list is a nested cons cell with the format \(MATCH CONS . REPLACEMENT\). @@ -207,20 +205,21 @@ non-nil value." (choice string (const nil))))) (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 + "Allow a key binding to be modified by multiple elements. +When non-nil, this allows a single key binding to match multiple +patterns in `which-key-replacement-alist'. When nil, only the +first match is used to perform replacements from `which-key-replacement-alist'." :group 'which-key :type 'boolean) (defcustom which-key-show-docstrings nil - "If non-nil, show each command's docstring next to the command -in the which-key buffer. This will only display the docstring up -to the first line break. If you set this variable to the symbol -docstring-only, then the command's name with be omitted. You -probably also want to adjust `which-key-max-description-length' -at the same time if you use this feature." + "If non-nil, show each command's docstring in the which-key popup. +This will only display the docstring up to the first line +break. If you set this variable to the symbol docstring-only, +then the command's name with be omitted. You probably also want +to adjust `which-key-max-description-length' at the same time if +you use this feature." :group 'which-key :type '(radio (const :tag "Do not show docstrings" nil) @@ -228,9 +227,9 @@ at the same time if you use this feature." (const :tag "Replace command name with docstring" docstring-only))) (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 + "Rules 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)." @@ -238,9 +237,9 @@ face to apply)." :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. + "These keys will automatically be truncated to one character. +They also have `which-key-special-key-face' applied to them. This +is disabled by default. An example configuration is \(setq which-key-special-keys \\='(\"SPC\" \"TAB\" \"RET\" \"ESC\" \"DEL\")\)" :group 'which-key @@ -252,7 +251,7 @@ disabled by default. Try this to see the effect. :type 'string) (defcustom which-key-show-prefix 'echo - "Whether to and where to display the current prefix sequence + "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 @@ -277,8 +276,8 @@ and nil. Nil turns the feature off." :type 'integer) (defcustom which-key-max-display-columns nil - "Maximum number of columns to display in the which-key buffer -nil means don't impose a maximum." + "Maximum number of columns to display in the which-key buffer. +A value of nil means don't impose a maximum." :group 'which-key :type '(choice integer (const :tag "Unbounded" nil))) @@ -297,9 +296,9 @@ location is tried." (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', + "The `slot' to use for `display-buffer-in-side-window'. +This applies 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 @@ -311,14 +310,14 @@ the right of) the middle slot. The default is zero." :type 'integer) (defcustom which-key-side-window-max-width 0.333 - "Maximum width of which-key popup when type is side-window + "Maximum width of which-key popup when type is side-window. 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 + "Maximum height of which-key popup when type is side-window. 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 @@ -335,9 +334,9 @@ a percentage out of the frame's height." :type 'integer) (defcustom which-key-allow-imprecise-window-fit (not (display-graphic-p)) - "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. + "Allow which-key to use a simpler method for resizing the popup. +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 and https://github.com/justbur/emacs-which-key/issues/225." @@ -351,8 +350,9 @@ and https://github.com/justbur/emacs-which-key/issues/225." (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 + "Order in which the key bindings are sorted. +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) @@ -371,9 +371,9 @@ information." (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." + "If non-nil, uppercase comes before lowercase in sorting. +This applies to the function chosen in +`which-key-sort-order'. Otherwise, the order is reversed." :group 'which-key :type 'boolean) @@ -383,8 +383,8 @@ is reversed." :type '(repeat string)) (defcustom which-key-paging-key "" - "Key to use for changing pages. Bound after each of the -prefixes in `which-key-paging-prefixes'" + "Key to use for changing pages. +Bound after each of the prefixes in `which-key-paging-prefixes'" :group 'which-key :type 'string) @@ -400,18 +400,18 @@ prefixes in `which-key-paging-prefixes'" ;; :type '(repeat symbol)) (defcustom which-key-use-C-h-commands t - "Use C-h (or whatever `help-char' is set to) for paging if -non-nil. Normally C-h after a prefix calls + "Use C-h (`help-char') for paging if non-nil. +Normally `help-char' 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-show-early-on-C-h nil - "Show the which-key buffer before if C-h (or whatever -`help-char' is set to) is pressed in the middle of a prefix -before the which-key buffer would normally be triggered through -the idle delay. If combined with the following settings, + "Allow C-h (`help-char') to trigger which-key popup before timer. +Show the which-key buffer if `help-char' is pressed in the middle +of a prefix before the which-key buffer would normally be +triggered by the time. If combined with the following settings, which-key will effectively only show when triggered \"manually\" using C-h. @@ -429,10 +429,12 @@ Note that `which-key-idle-delay' should be set before turning on :type 'boolean) (defcustom which-key-preserve-window-configuration nil - "If non-nil, save window configuration before which-key buffer is shown -and restore it after which-key buffer is hidden. It prevents which-key from -changing window position of visible buffers. -Only takken into account when popup type is side-window." + "Save and restore window configuration around which-key popup display. +If non-nil, save window configuration before which-key buffer is +shown and restore it after which-key buffer is hidden. It +prevents which-key from changing window position of visible +buffers. Only takken into account when popup type is +side-window." :group 'which-key :type 'boolean) @@ -453,8 +455,8 @@ Only takken into account when popup type is side-window." which-key-separator "abort" " 1..9" which-key-separator "digit-arg") - "Prompt to display when invoking `which-key-C-h-map'. This string -is fed into `substitute-command-keys'") + "Prompt to display when invoking `which-key-C-h-map'. +This string is fed into `substitute-command-keys'") (defvar which-key-C-h-map (let ((map (make-sparse-keymap))) @@ -506,7 +508,8 @@ See http://www.gnu.org/software/emacs/manual/html_node/emacs/Modifier-Keys.html" :type 'boolean) (defcustom which-key-delay-functions nil - "A list of functions that may decide whether to delay the + "List of functions that may delay the which-key popup. +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 @@ -529,11 +532,10 @@ key sequences is what is produced by `key-description'." :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'." + "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)) @@ -613,7 +615,7 @@ and it matches a string in `which-key-highlighted-command-list'." ;;;; Custom popup (defcustom which-key-custom-popup-max-dimensions-function nil - "Variable to hold a custom max-dimensions function. + "Set 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)." @@ -621,13 +623,13 @@ which-key popup in the form a cons cell (height . width)." :type '(choice function (const nil))) (defcustom which-key-custom-hide-popup-function nil - "Variable to hold a custom hide-popup function. + "Set a custom hide-popup function. It takes no arguments and the return value is ignored." :group 'which-key :type '(choice function (const nil))) (defcustom which-key-custom-show-popup-function nil - "Variable to hold a custom show-popup function. + "Set 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." @@ -640,15 +642,16 @@ ignored." :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 + "Prevent which-key from popping up momentarily. +This can be used by setting this to a non-nil value for the +execution of a command, as in \(let \(\(which-key-inhibit t\)\) ...\)") (defvar which-key-keymap-history nil - "History of keymap selections in functions like -`which-key-show-keymap'.") + "History of keymap selections. +Used in functions like `which-key-show-keymap'.") ;;; Internal Vars @@ -775,22 +778,21 @@ operators." :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." + "Show the keys following an evil command that reads a motion. +These are commands typically mapped to keys 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.") + "Support god-mode if non-nil.") (defvar which-key--god-mode-key-string nil - "Holds key string to use for god-mode support.") + "String to use for god-mode support.") (defun which-key--god-mode-lookup-command-advice (orig-fun arg1 &rest args) (setq which-key--god-mode-key-string arg1) @@ -873,8 +875,8 @@ disable support." (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)." + "Reduce `echo-keystrokes' if necessary. +It will interfere if 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) @@ -883,7 +885,8 @@ it's set too high)." echo-keystrokes which-key-echo-keystrokes)))) (defun which-key-remove-default-unicode-chars () - "Use of `which-key-dont-use-unicode' is preferred to this + "Remove default unicode chars from settings. +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." @@ -894,7 +897,7 @@ starter kit for example." ;;;###autoload (defun which-key-setup-side-window-right () - "Apply suggested settings for side-window that opens on right." + "Set up side-window on right." (interactive) (setq which-key-popup-type 'side-window which-key-side-window-location 'right @@ -902,8 +905,8 @@ starter kit for example." ;;;###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." + "Set up side-window on right if space allows. +Otherwise, use bottom." (interactive) (setq which-key-popup-type 'side-window which-key-side-window-location '(right bottom) @@ -911,7 +914,7 @@ if there is space and the bottom otherwise." ;;;###autoload (defun which-key-setup-side-window-bottom () - "Apply suggested settings for side-window that opens on bottom." + "Set up side-window that opens on bottom." (interactive) (which-key--setup-echo-keystrokes) (setq which-key-popup-type 'side-window @@ -920,7 +923,7 @@ if there is space and the bottom otherwise." ;;;###autoload (defun which-key-setup-minibuffer () - "Apply suggested settings for minibuffer. + "Set up minibuffer display. Do not use this setup if you use the paging commands. Instead use `which-key-setup-side-window-bottom', which is nearly identical but more functional." @@ -1049,7 +1052,7 @@ If AT-ROOT is non-nil the binding is also placed at the root of MAP." ;;; Functions for computing window sizes (defun which-key--text-width-to-total (text-width) - "Convert window text-width to window total-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 @@ -1065,7 +1068,7 @@ width as the frame." 3))) (defun which-key--total-width-to-text (total-width) - "Convert window total-width to window text-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 @@ -1135,8 +1138,7 @@ total height." (which-key--hide-popup-ignore-command))) (defun which-key--hide-popup-ignore-command () - "Version of `which-key--hide-popup' without the check of -`real-this-command'." + "`which-key--hide-popup' without the check of `real-this-command'." (cl-case which-key-popup-type ;; Not necessary to hide minibuffer ;; (minibuffer (which-key--hide-buffer-minibuffer)) @@ -1288,7 +1290,8 @@ call signature in different emacs versions" ;;; Max dimension of available window functions (defun which-key--popup-max-dimensions () - "Dimesion functions should return the maximum possible (height + "Return maximum dimension available for popup. +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." @@ -1312,8 +1315,9 @@ Measured in lines and characters respectively." (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." + "Return max-dimensions of the side-window popup. +The return value should be (height . width) in lines and +characters respectively." (cons ;; height (if (member which-key-side-window-location '(left right)) @@ -1336,8 +1340,9 @@ width) in lines and characters respectively." which-key-unicode-correction)))) (defun which-key--frame-max-dimensions () - "Return max-dimensions of the frame popup (height . -width) in lines and characters respectively." + "Return max-dimensions of the frame popup. +The return value should be (height . width) in lines and +characters respectively." (cons which-key-frame-max-height which-key-frame-max-width)) ;;; Sorting functions @@ -1363,8 +1368,8 @@ width) in lines and characters respectively." (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'." + "Key sorting function. +Used for `which-key-key-order' and `which-key-key-order-alpha'." (save-match-data (let* ((a (which-key--extract-key a)) (b (which-key--extract-key b)) @@ -1435,9 +1440,8 @@ Uses `string-lessp' after applying lowercase." (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'." + "Order prefixes before non-prefixes. +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?)) @@ -1445,9 +1449,8 @@ coming before a prefix. Within these categories order using (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'." + "Order prefixes before non-prefixes. +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?)) @@ -1455,9 +1458,8 @@ coming before a prefix. Within these categories order using (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'." + "Order local bindings before non-local ones. +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?)) @@ -1662,10 +1664,10 @@ cell" el))))) (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. + "Add face to DESCRIPTION. +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'." @@ -1736,7 +1738,8 @@ return the docstring." (format "%s %s" current docstring))))) (defun which-key--format-and-replace (unformatted &optional preserve-full-key) - "Take a list of (key . desc) cons cells in UNFORMATTED, add + "Make list of key bindings with separators and descriptions. +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 @@ -1774,8 +1777,7 @@ alists. Returns a list (key separator description)." (defun which-key--compute-binding (binding) "Replace BINDING with remapped binding if it exists. - -Requires `which-key-compute-remaps' to be non-nil" +Requires `which-key-compute-remaps' to be non-nil." (let (remap) (if (and which-key-compute-remaps (setq remap (command-remapping binding))) @@ -1909,14 +1911,14 @@ non-nil, then bindings are collected recursively for all prefixes." (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n"))) (defsubst which-key--max-len (keys index &optional initial-value) - "Internal function for finding the max length of the INDEX -element in each list element of KEYS." + "Find the max length of the INDEX element in each of KEYS." (cl-reduce (lambda (x y) (max x (which-key--string-width (nth index y)))) keys :initial-value (if initial-value initial-value 0))) (defun which-key--pad-column (col-keys avl-width) - "Take a column of (key separator description) COL-KEYS, + "Pad cells of COL-KEYS to AVL-WIDTH. +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 @@ -2111,8 +2113,8 @@ max-lines max-width avl-lines avl-width (which-key--pages-height result)) (_ (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." + "Return a description of the full key sequence up to now. +Include prefix arguments." (let* ((left (eq which-key-show-prefix 'left)) (prefix-arg (if -prefix-arg -prefix-arg prefix-arg)) (str (concat @@ -2137,9 +2139,9 @@ including prefix arguments." map))) (defun which-key--process-page (pages-obj) - "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." + "Add information to the basic list of key bindings. +Include, if applicable, the current prefix, the name of the current +prefix, and a page count." (let* ((page (car (which-key--pages-pages pages-obj))) (height (which-key--pages-height pages-obj)) (n-pages (which-key--pages-num-pages pages-obj)) @@ -2285,8 +2287,7 @@ Usually this is `describe-prefix-bindings'." ;;;###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'." + "Show next page of keys or `which-key-show-standard-help'." (interactive) (let ((which-key-inhibit t)) (if (which-key--on-last-page) @@ -2295,8 +2296,7 @@ call `which-key-show-standard-help'." ;;;###autoload (defun which-key-show-previous-page-no-cycle () - "Show previous page of keys unless on the first page, in which -case do nothing." + "Show previous page of keys if one exists." (interactive) (let ((which-key-inhibit t)) (unless (which-key--on-first-page) @@ -2304,16 +2304,14 @@ case do nothing." ;;;###autoload (defun which-key-show-next-page-cycle (&optional _) - "Show the next page of keys, cycling from end to beginning -after last page." + "Show the next page of keys, cycling from end to beginning." (interactive) (let ((which-key-inhibit t)) (which-key-turn-page 1))) ;;;###autoload (defun which-key-show-previous-page-cycle (&optional _) - "Show the previous page of keys, cycling from beginning to end -after first page." + "Show the previous page of keys, cycling from beginning to end." (interactive) (let ((which-key-inhibit t)) (which-key-turn-page -1))) @@ -2327,7 +2325,6 @@ after first page." ;;;###autoload (defun which-key-show-major-mode (&optional all) "Show top-level bindings in the map of the current major mode. - This function will also detect evil bindings made using `evil-define-key' in this map. These bindings will depend on the current evil state. " @@ -2344,7 +2341,6 @@ current evil state. " ;;;###autoload (defun which-key-show-full-major-mode () "Show all bindings in the map of the current major mode. - This function will also detect evil bindings made using `evil-define-key' in this map. These bindings will depend on the current evil state. " @@ -2354,7 +2350,6 @@ current evil state. " ;;;###autoload (defun which-key-dump-bindings (prefix buffer-name) "Dump bindings from PREFIX into buffer named BUFFER-NAME. - PREFIX should be a string suitable for `kbd'." (interactive "sPrefix: \nB") (let* ((buffer (get-buffer-create buffer-name)) @@ -2409,9 +2404,9 @@ PREFIX should be a string suitable for `kbd'." ;;;###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." + "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) (cond ((and (not (which-key--popup-showing-p)) which-key-show-early-on-C-h) @@ -2460,7 +2455,6 @@ prefix) if `which-key-use-C-h-commands' is non nil." (defun which-key--try-2-side-windows (bindings prefix-keys prefix-title loc1 loc2 &rest _ignore) "Try to show BINDINGS (PAGE-N) in LOC1 first. - Only if no bindings fit fallback to LOC2." (let (pages1) (let ((which-key-side-window-location loc1) @@ -2655,8 +2649,7 @@ Finally, show the buffer." this-command-keys)) (defun which-key--update () - "Function run by timer to possibly trigger -`which-key--create-buffer-and-show'." + "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." (let ((prefix-keys (which-key--this-command-keys)) delay-time) (cond ((and (> (length prefix-keys) 0) commit bf1cf8147b7ff5087e7a7d771784fb393878ce0c Author: Jeremy Bryant Date: Thu Feb 8 23:28:10 2024 +0000 * which-key.el: Add two spaces in docstrings and punctation (which-key-echo-keystrokes): (which-key-popup-type): (which-key-min-display-lines): (which-key-side-window-location): (which-key-show-early-on-C-h): (which-key-allow-regexps): (which-key-group-description-face): (which-key-docstring-face): (which-key-enable-god-mode-support): (which-key-setup-minibuffer): (which-key-add-keymap-based-replacements): (which-key--maybe-replace): (which-key--maybe-add-docstring): (which-key--get-keymap-bindings): (which-key-reload-key-sequence): diff --git a/which-key.el b/which-key.el index d68942cf8b1..4a19d1622f6 100644 --- a/which-key.el +++ b/which-key.el @@ -24,13 +24,13 @@ ;;; Commentary: -;; which-key provides the minor mode which-key-mode for Emacs. The mode displays +;; 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 +;; 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 +;; 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. ;; @@ -51,7 +51,7 @@ ;;; Options (defgroup which-key nil - "Customization options for which-key-mode" + "Customization options for which-key-mode." :group 'help :prefix "which-key-") @@ -81,7 +81,7 @@ this behavior." 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-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 @@ -264,7 +264,7 @@ and nil. Nil turns the feature off." (const :tag "Hide" nil))) (defcustom which-key-popup-type 'side-window - "Supported types are minibuffer, side-window, frame, and custom" + "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) @@ -272,7 +272,7 @@ and nil. Nil turns the feature off." (const :tag "Use your custom display functions" custom))) (defcustom which-key-min-display-lines 1 - "Minimum number of horizontal lines to display in the which-key buffer" + "Minimum number of horizontal lines to display in the which-key buffer." :group 'which-key :type 'integer) @@ -284,9 +284,9 @@ nil means don't impose a maximum." (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 +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) @@ -419,7 +419,7 @@ using C-h. \(setq `which-key-idle-secondary-delay' 0.05) Note that `which-key-idle-delay' should be set before turning on -`which-key-mode'. " +`which-key-mode'." :group 'which-key :type 'boolean) @@ -523,7 +523,7 @@ The delay time is effectively added to the normal (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 +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)) @@ -597,7 +597,7 @@ and it matches a string in `which-key-highlighted-command-list'." (defface which-key-group-description-face '((t . (:inherit font-lock-keyword-face))) - "Face for the key description when it is a group or prefix" + "Face for the key description when it is a group or prefix." :group 'which-key-faces) (defface which-key-special-key-face @@ -607,7 +607,7 @@ and it matches a string in `which-key-highlighted-command-list'." (defface which-key-docstring-face '((t . (:inherit which-key-note-face))) - "Face for docstrings" + "Face for docstrings." :group 'which-key-faces) ;;;; Custom popup @@ -802,7 +802,7 @@ problems at github.") (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 +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)) @@ -921,7 +921,7 @@ if there is space and the bottom otherwise." ;;;###autoload (defun which-key-setup-minibuffer () "Apply suggested settings for minibuffer. -Do not use this setup if you use the paging commands. Instead use +Do not use this setup if you use the paging commands. Instead use `which-key-setup-side-window-bottom', which is nearly identical but more functional." (interactive) @@ -956,7 +956,7 @@ for REPLACEMENT will eventually be removed." (or (which-key--safe-lookup-key-description keymap key) (make-sparse-keymap)))) (t - (user-error "replacement is neither a cons cell or a string"))))) + (user-error "Replacement is neither a cons cell or a string"))))) (define-key keymap (kbd key) def)) (setq key (pop more) replacement (pop more)))) @@ -1521,7 +1521,7 @@ local bindings coming first. Within these categories order using (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'." +which are strings. KEY is of the form produced by `key-binding'." (let* ((replacer (if which-key-allow-multiple-replacements #'which-key--replace-in-repl-list-many #'which-key--replace-in-repl-list-once))) @@ -1709,7 +1709,7 @@ ORIGINAL-DESCRIPTION is the description given by (defun which-key--maybe-add-docstring (current original) "Maybe concat a docstring to CURRENT and return result. Specifically, do this if ORIGINAL is a command with a docstring -and `which-key-show-docstrings' is non-nil. If +and `which-key-show-docstrings' is non-nil. If `which-key-show-docstrings' is the symbol docstring-only, just return the docstring." (let* ((orig-sym (intern original)) @@ -1847,7 +1847,7 @@ Requires `which-key-compute-remaps' to be non-nil" (keymap &optional start prefix filter all evil) "Retrieve top-level bindings from KEYMAP. PREFIX limits bindings to those starting with this key -sequence. START is a list of existing bindings to add to. If ALL +sequence. START is a list of existing bindings to add to. If ALL is non-nil, recursively retrieve all bindings below PREFIX. If EVIL is non-nil, extract active evil bidings." (let ((bindings start) @@ -2245,7 +2245,7 @@ enough space based on your settings and frame size." prefix-keys) (defun which-key-reload-key-sequence (&optional key-seq) "Simulate entering the key sequence KEY-SEQ. KEY-SEQ should be a list of events as produced by -`listify-key-sequence'. If nil, KEY-SEQ defaults to +`listify-key-sequence'. If nil, KEY-SEQ defaults to `which-key--current-key-list'. Any prefix arguments that were used are reapplied to the new key sequence." (let* ((key-seq (or key-seq (which-key--current-key-list))) commit 4d20bc852545a2e602f59084a630f888542052b1 Author: Justin Burkett Date: Tue Sep 5 17:28:29 2023 -0400 Fix popup with no space Fixes #317 diff --git a/which-key.el b/which-key.el index 25f2397a9a8..d68942cf8b1 100644 --- a/which-key.el +++ b/which-key.el @@ -2682,7 +2682,9 @@ Finally, show the buffer." (and which-key--god-mode-support-enabled (bound-and-true-p god-local-mode) (eq this-command 'god-mode-self-insert)) - (null this-command))) + (null this-command)) + (let ((max-dim (which-key--popup-max-dimensions))) + (> (min (car-safe max-dim) (cdr-safe max-dim)) 0))) (when (and (not (equal prefix-keys (which-key--current-prefix))) (or (null which-key-delay-functions) (null (setq delay-time commit df6b0cb8449812e7fb200bc852107fa7eb708496 Author: Justin Burkett Date: Wed Jul 12 17:51:08 2023 -0400 Add which-key-C-h-map-prompt to make it customizable Fixes #350 diff --git a/which-key.el b/which-key.el index f7c4f160625..25f2397a9a8 100644 --- a/which-key.el +++ b/which-key.el @@ -437,6 +437,25 @@ Only takken into account when popup type is side-window." 'which-key :type 'boolean) +(defvar which-key-C-h-map-prompt + (concat " \\" + " \\[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-toggle-docstrings]" + which-key-separator "toggle-docstrings," + " \\[which-key-show-standard-help]" + which-key-separator "help," + " \\[which-key-abort]" + which-key-separator "abort" + " 1..9" + which-key-separator "digit-arg") + "Prompt to display when invoking `which-key-C-h-map'. This string +is fed into `substitute-command-keys'") + (defvar which-key-C-h-map (let ((map (make-sparse-keymap))) (dolist (bind `(("\C-a" . which-key-abort) @@ -2419,22 +2438,7 @@ prefix) if `which-key-use-C-h-commands' is non nil." full-prefix (which-key--propertize (substitute-command-keys - (concat - " \\" - " \\[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-toggle-docstrings]" - which-key-separator "toggle-docstrings," - " \\[which-key-show-standard-help]" - which-key-separator "help," - " \\[which-key-abort]" - which-key-separator "abort" - " 1..9" - which-key-separator "digit-arg")) + which-key-C-h-map-prompt) 'face 'which-key-note-face))) (key (let ((key (read-key prompt))) (if (numberp key) commit ee6f0637f75ded903653b7a300a8588e3a8427f7 Author: Justin Burkett Date: Tue Jun 6 18:27:27 2023 -0400 Remove old "recent changes" from README diff --git a/README.org b/README.org index 82a1466961f..cc7d0cfb65f 100644 --- a/README.org +++ b/README.org @@ -3,29 +3,6 @@ [[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]] -** Recent Changes -*** 2021-06-21: Add support for menu-item bindings - =which-key= will now detect and compute the result of =menu-item= - bindings. As a consequence of reworking the internals, - =which-key-enable-extended-define-key= is now obsolete (the associated - behavior is supported by default). - -*** 2020-08-28: Added =which-key-add-keymap-based-replacements= - This function provides an alternative interface allowing replacements to be - stored directly in keymaps, allowing one to avoid using - =which-key-replacement-alist=, which may cause performance issues when it - gets very big. -*** 2019-08-01: Added =which-key-show-early-on-C-h= - Allows one to trigger =which-key= on demand, rather than automatically. See - the docstring and [[#manual-activation][Manual Activation]]. - -*** 2017-12-13: Added =which-key-enable-extended-define-key= - Allows for a concise syntax to specify replacement text using =define-key= - or alternatives that use =define-key= internally. See the docstring and - [[#custom-string-replacement-options][Custom String Replacement]]. - -*** 2017-11-13: Added =which-key-show-major-mode= - Shows active bindings in current major-mode map. ** Introduction =which-key= is a minor mode for Emacs that displays the key bindings following your currently entered incomplete command (a prefix) in a @@ -39,12 +16,6 @@ ** Table of Contents :TOC_3: - [[#which-key][which-key]] - - [[#recent-changes][Recent Changes]] - - [[#2021-06-21-add-support-for-menu-item-bindings][2021-06-21: Add support for menu-item bindings]] - - [[#2020-08-28-added-which-key-add-keymap-based-replacements][2020-08-28: Added =which-key-add-keymap-based-replacements=]] - - [[#2019-08-01-added-which-key-show-early-on-c-h][2019-08-01: Added =which-key-show-early-on-C-h=]] - - [[#2017-12-13-added-which-key-enable-extended-define-key][2017-12-13: Added =which-key-enable-extended-define-key=]] - - [[#2017-11-13-added-which-key-show-major-mode][2017-11-13: Added =which-key-show-major-mode=]] - [[#introduction][Introduction]] - [[#install][Install]] - [[#melpa][MELPA]] commit bd34ede7bf77ad3988330b37207f3978e7342c79 Author: Justin Burkett Date: Thu Mar 30 17:21:49 2023 -0400 Catch errors in kbd Fixes #346 diff --git a/which-key.el b/which-key.el index f46d6e224a8..f7c4f160625 100644 --- a/which-key.el +++ b/which-key.el @@ -732,6 +732,16 @@ checked." (when (and result (not (numberp result))) result)))) +(defsubst which-key--safe-lookup-key-description (keymap key) + "Version of `lookup-key' that allows KEYMAP to be nil. +Also convert numeric results of `lookup-key' to nil. KEY +should be formatted as an input for `kbd'." + (let ((key (ignore-errors (kbd key)))) + (when (and key (keymapp keymap)) + (let ((result (lookup-key keymap key))) + (when (and result (not (numberp result))) + result))))) + ;;; Third-party library support ;;;; Evil @@ -924,7 +934,7 @@ for REPLACEMENT will eventually be removed." ((consp replacement) replacement) ((stringp replacement) (cons replacement - (or (which-key--safe-lookup-key keymap (kbd key)) + (or (which-key--safe-lookup-key-description keymap key) (make-sparse-keymap)))) (t (user-error "replacement is neither a cons cell or a string"))))) @@ -1520,8 +1530,9 @@ which are strings. KEY is of the form produced by `key-binding'." (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)))) + (eq (which-key--safe-lookup-key-description + (current-local-map) + (which-key--current-key-string (car keydesc))) (intern (cdr keydesc)))) (defun which-key--map-binding-p (map keydesc) @@ -1529,15 +1540,15 @@ which are strings. KEY is of the form produced by `key-binding'." (or (when (bound-and-true-p evil-state) (let ((lookup - (which-key--safe-lookup-key + (which-key--safe-lookup-key-description map - (kbd (which-key--current-key-string - (format "<%s-state> %s" evil-state (car keydesc))))))) + (which-key--current-key-string + (format "<%s-state> %s" evil-state (car keydesc)))))) (or (eq lookup (intern (cdr keydesc))) (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command"))))) (let ((lookup - (which-key--safe-lookup-key - map (kbd (which-key--current-key-string (car keydesc)))))) + (which-key--safe-lookup-key-description + map (which-key--current-key-string (car keydesc))))) (or (eq lookup (intern (cdr keydesc))) (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command")))))) @@ -1719,7 +1730,8 @@ alists. Returns a list (key separator description)." (let* ((keys (car key-binding)) (orig-desc (cdr key-binding)) (group (which-key--group-p orig-desc)) - (local (eq (which-key--safe-lookup-key local-map (kbd keys)) + (local (eq (which-key--safe-lookup-key-description + local-map keys) (intern orig-desc))) (hl-face (which-key--highlight-face orig-desc)) (key-binding (which-key--maybe-replace key-binding)) commit 8093644032854b1cdf3245ce4e3c7b6673f741bf Merge: 2875fcdc93a e9931138683 Author: Justin Burkett Date: Thu Aug 11 12:16:11 2022 -0400 Merge commit 'pullreqs/343' commit 2875fcdc93acb02863ed0315588cb9e8e9a732e5 Author: Justin Burkett Date: Thu Aug 11 09:32:24 2022 -0400 Ignore .DS_Store diff --git a/.gitignore b/.gitignore index 5998b430cd1..0d9e6e119b0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ *~ *.elc +.DS_Store # Autogenerated by GNU ELPA scripts /which-key-autoloads.el commit 23fc54eb80890b28a72071f72437880c5bfbf94b Merge: 1ab1d0cc888 55b2440de04 Author: Justin Burkett Date: Thu Aug 11 09:24:40 2022 -0400 Merge pull request #342 from tarsiiformes/quote-quote Replace or quote certain single quotes in docstrings commit e993113868305221db8dff8b37be81cca2bfa139 Author: Jonas Bernoulli Date: Thu Aug 4 14:05:16 2022 +0200 Allow truncating without using any ellipsis Depending on how bindings are displayed showing docstrings can result in most lines being too long and adding ellipses to most lines can be quite ugly and distracting. diff --git a/which-key.el b/which-key.el index 2062a737abe..552b6a749a0 100644 --- a/which-key.el +++ b/which-key.el @@ -142,13 +142,13 @@ the default is \" : \"." (defcustom which-key-ellipsis (if which-key-dont-use-unicode ".." "…") - "Ellipsis to use when truncating. Default is \"…\", unless -`which-key-dont-use-unicode' is non nil, in which case -the default is \"..\"." + "Ellipsis to use when truncating. +Default is \"…\", unless `which-key-dont-use-unicode' is non nil, +in which case the default is \"..\". This can also be the empty +string to truncate without using any ellipsis." :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 \"+\"." @@ -1604,10 +1604,13 @@ If KEY contains any \"special keys\" defined in (function (let ((val (funcall max avl-width))) (if (floatp val) (truncate val) val)))))) (if (and max (> (length desc) max)) - (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) - (dots (which-key--propertize which-key-ellipsis - 'face last-face))) - (concat (substring desc 0 (- max (length dots))) dots)) + (let ((dots (and (not (equal which-key-ellipsis "")) + (which-key--propertize + which-key-ellipsis 'face + (get-text-property (1- (length desc)) 'face desc))))) + (if dots + (concat (substring desc 0 (- max (length dots))) dots) + (substring desc 0 max))) desc))) (defun which-key--highlight-face (description) commit 08d57febc4bcebc6d228c215e363a589498894da Author: Jonas Bernoulli Date: Thu Aug 4 14:05:15 2022 +0200 Don't make description longer than allowed when truncating Truncating the description to the allowed maximal length and then appending an ellipsis, makes the final text longer than allowed. The length of the ellipsis has to be taken into account. diff --git a/which-key.el b/which-key.el index a2986269fdd..2062a737abe 100644 --- a/which-key.el +++ b/which-key.el @@ -1605,8 +1605,9 @@ If KEY contains any \"special keys\" defined in (if (floatp val) (truncate val) val)))))) (if (and max (> (length desc) max)) (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) - (dots (which-key--propertize which-key-ellipsis 'face last-face))) - (concat (substring desc 0 max) dots)) + (dots (which-key--propertize which-key-ellipsis + 'face last-face))) + (concat (substring desc 0 (- max (length dots))) dots)) desc))) (defun which-key--highlight-face (description) commit 783d6954bcea18c94d7eee723286f820fbd8b4b2 Author: Jonas Bernoulli Date: Thu Aug 4 14:05:13 2022 +0200 Support different types for which-key-max-description-length Using a function is useful, e.g., to use a different maximal width, depending on the value of `which-key-show-docstrings'. diff --git a/README.org b/README.org index 9d9a4c4a57b..82a1466961f 100644 --- a/README.org +++ b/README.org @@ -520,6 +520,7 @@ ;; Set the maximum length (in characters) for key descriptions (commands or ;; prefixes). Descriptions that are longer are truncated and have ".." added. + ;; This can also be a float (fraction of available width) or a function. (setq which-key-max-description-length 27) ;; Use additional padding between columns of keys. This variable specifies the diff --git a/which-key.el b/which-key.el index 529cceb40a1..a2986269fdd 100644 --- a/which-key.el +++ b/which-key.el @@ -89,9 +89,16 @@ which-key popup." (defcustom which-key-max-description-length 27 "Truncate the description of keys to this length. -Also adds \"..\". If nil, disable any truncation." +Either nil (no truncation), an integer (truncate after that many +characters), a float (use that fraction of the available width), +or a function, which takes one argument, the available width in +characters, and whose return value has one of the types mentioned +before. Truncation is done using `which-key-ellipsis'." :group 'which-key - :type '(choice integer (const :tag "Disable truncation" nil))) + :type '(choice (const :tag "Disable truncation" nil) + (integer :tag "Width in characters") + (float :tag "Use fraction of available width") + function)) (defcustom which-key-min-column-description-width 0 "Every column should at least have this width." @@ -1587,14 +1594,20 @@ If KEY contains any \"special keys\" defined in (which-key--string-width key-w-face)))) key-w-face)))) -(defsubst which-key--truncate-description (desc) +(defsubst which-key--truncate-description (desc avl-width) "Truncate DESC description to `which-key-max-description-length'." - (if (and which-key-max-description-length - (> (length desc) which-key-max-description-length)) - (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) - (dots (which-key--propertize which-key-ellipsis 'face last-face))) - (concat (substring desc 0 which-key-max-description-length) dots)) - desc)) + (let* ((max which-key-max-description-length) + (max (cl-etypecase max + (null nil) + (integer max) + (float (truncate (* max avl-width))) + (function (let ((val (funcall max avl-width))) + (if (floatp val) (truncate val) val)))))) + (if (and max (> (length desc) max)) + (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) + (dots (which-key--propertize which-key-ellipsis 'face last-face))) + (concat (substring desc 0 max) dots)) + desc))) (defun which-key--highlight-face (description) "Return the highlight face for DESCRIPTION if it has one." @@ -1696,6 +1709,7 @@ alists. Returns a list (key separator description)." (which-key--propertize which-key-separator 'face 'which-key-separator-face)) (local-map (current-local-map)) + (avl-width (cdr (which-key--popup-max-dimensions))) new-list) (dolist (key-binding unformatted) (let* ((keys (car key-binding)) @@ -1710,7 +1724,8 @@ alists. Returns a list (key separator description)." (when final-desc (setq final-desc (which-key--truncate-description - (which-key--maybe-add-docstring final-desc orig-desc)))) + (which-key--maybe-add-docstring final-desc orig-desc) + avl-width))) (when (consp key-binding) (push (list (which-key--propertize-key commit fe68fe28126efa44a1050a2eedfc719c23054db1 Author: Jonas Bernoulli Date: Thu Aug 4 14:05:12 2022 +0200 Avoid unnecessary work diff --git a/which-key.el b/which-key.el index ba446a56737..529cceb40a1 100644 --- a/which-key.el +++ b/which-key.el @@ -1589,12 +1589,12 @@ If KEY contains any \"special keys\" defined in (defsubst which-key--truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." - (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) - (dots (which-key--propertize which-key-ellipsis 'face last-face))) - (if (and which-key-max-description-length - (> (length desc) which-key-max-description-length)) - (concat (substring desc 0 which-key-max-description-length) dots) - desc))) + (if (and which-key-max-description-length + (> (length desc) which-key-max-description-length)) + (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) + (dots (which-key--propertize which-key-ellipsis 'face last-face))) + (concat (substring desc 0 which-key-max-description-length) dots)) + desc)) (defun which-key--highlight-face (description) "Return the highlight face for DESCRIPTION if it has one." commit 245be33189fdba26997fc565742ce7a0e78232aa Author: Jonas Bernoulli Date: Thu Aug 4 14:05:11 2022 +0200 Fix vertical off-by-one error When the usage information is displayed at the top or bottom (as controlled by `which-key-show-prefix'), then we already accounted for that by putting (- max-height 1) bindings in each row. But we did not ensure that the max-height is used when displaying the result. Instead we used (- max-height 1) here too. When trying to display usage information at the bottom, the result is that it is not displayed because it is off-window. When displaying at the top, then it is displayed, but the last binding is off-window and never displayed. This bug did not matter (much) when using the default settings because then the code used for displaying the window actually ignores the max-height and just uses the height appropriate to display all lines in the buffer (i.e., (+ max-height 1)). However, other display methods, including but not necessarily limited to third-party methods (such as `which-key-posframe') may choose to, or absolutely have to, respect max-height. In particular, anything that tries to use the full height of a frame or window, will be affected by this. diff --git a/which-key.el b/which-key.el index 9d5e403f6d8..ba446a56737 100644 --- a/which-key.el +++ b/which-key.el @@ -1989,6 +1989,9 @@ is the width of the live window." (or prefix-title (which-key--maybe-get-prefix-title (key-description prefix-keys)))) + (when prefix-top-bottom + ;; Add back the line earlier reserved for the page information. + (setf (which-key--pages-height result) max-lines)) (when (and (= (which-key--pages-num-pages result) 1) (> which-key-min-display-lines (which-key--pages-height result))) commit 5fe2d3317d60411970e662d62ffc05fe5eac7319 Author: Jonas Bernoulli Date: Thu Aug 4 14:05:09 2022 +0200 Fix horizontal off-by-one error Delay increasing width used by columns until we know that we have to do so because we have determined that there is enough room to add an additional column and a space between the last two columns. If we don't do that, then we can easily get an off-by-one error. If docstrings are shown and the window is narrow, then it is likely that we end up using the maximal width. If we then add one to the actual width and later compare that again with the maximal width, then that is too width. diff --git a/which-key.el b/which-key.el index 8162d207f70..9d5e403f6d8 100644 --- a/which-key.el +++ b/which-key.el @@ -1877,7 +1877,7 @@ that width." (which-key--max-len col-keys 2 which-key-min-column-description-width))) - (col-width (+ 1 col-key-width col-sep-width col-desc-width)) + (col-width (+ col-key-width col-sep-width col-desc-width)) (col-format (concat "%" (int-to-string col-key-width) "s%s%-" (int-to-string col-desc-width) "s"))) (cons col-width @@ -1915,10 +1915,10 @@ as well as metadata." (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)) + (<= (+ page-width 1 (caar cols-w-widths)) avl-width)) (setq col (pop cols-w-widths)) (push (cdr col) page-cols) - (cl-incf page-width (car col)) + (cl-incf page-width (1+ (car col))) (cl-incf n-keys (length (cdr col))) (cl-incf n-columns)) (push (which-key--join-columns page-cols) pages) commit 254d6fdc2b3c993b599fc3ca29cda14bc6c0a5fb Author: Jonas Bernoulli Date: Thu Aug 4 14:05:08 2022 +0200 Don't pad beyond maximal width The old implementation behaved as if the "description" is the only information that is being displayed, however in actuality the available width has to be shared with the key (and the separator between the two). Failing to take that into account meant that every binding whose description isn't *by itself* wider than the width available to display all the information got excessive padding, which later has to be removed during truncation again (resulting in misleading ellipses). diff --git a/which-key.el b/which-key.el index 89bdbe86457..8162d207f70 100644 --- a/which-key.el +++ b/which-key.el @@ -1865,15 +1865,18 @@ element in each list element of KEYS." (lambda (x y) (max x (which-key--string-width (nth index y)))) keys :initial-value (if initial-value initial-value 0))) -(defun which-key--pad-column (col-keys) +(defun which-key--pad-column (col-keys avl-width) "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 which-key-min-column-description-width)) + (avl-width (- avl-width col-key-width col-sep-width)) + (col-desc-width (min avl-width + (which-key--max-len + col-keys 2 + which-key-min-column-description-width))) (col-width (+ 1 col-key-width col-sep-width col-desc-width)) (col-format (concat "%" (int-to-string col-key-width) "s%s%-" (int-to-string col-desc-width) "s"))) @@ -1893,8 +1896,8 @@ that width." "Convert list of KEYS to columns based on dimensions AVL-LINES and AVL-WIDTH. Returns a `which-key--pages' object 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))) + (let ((cols-w-widths (mapcar (lambda (c) (which-key--pad-column c avl-width)) + (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) commit 16c992f80fa6394b4dc5166e6c14129ec4946e12 Author: Jonas Bernoulli Date: Thu Aug 4 14:05:07 2022 +0200 Displaying just one column means pages are arranged vertically Third-party display methods may do that without using a side-window, and therefore they don't set `which-key-popup-type' to `side-window'. Likewise they might not set `which-key-side-window-location', e.g., because their display method only supports one location. `which-key-max-display-columns' being 1 is by itself already enough of an indicator to know that there won't be multiple columns. diff --git a/which-key.el b/which-key.el index d9dcf8dee9a..89bdbe86457 100644 --- a/which-key.el +++ b/which-key.el @@ -1972,8 +1972,9 @@ is the width of the live window." (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)))) + (vertical (or (and (eq which-key-popup-type 'side-window) + (member which-key-side-window-location '(left right))) + (eq which-key-max-display-columns 1))) result) (setq result (which-key--create-pages-1 commit d924a4a766d3f895acbddf02d01db1e3f049f899 Author: Jonas Bernoulli Date: Thu Aug 4 14:05:06 2022 +0200 Calculate format string only once diff --git a/which-key.el b/which-key.el index 19d1f9fb3d1..d9dcf8dee9a 100644 --- a/which-key.el +++ b/which-key.el @@ -1874,13 +1874,12 @@ that width." (col-sep-width (which-key--max-len col-keys 1)) (col-desc-width (which-key--max-len col-keys 2 which-key-min-column-description-width)) - (col-width (+ 1 col-key-width col-sep-width col-desc-width))) + (col-width (+ 1 col-key-width col-sep-width col-desc-width)) + (col-format (concat "%" (int-to-string col-key-width) + "s%s%-" (int-to-string col-desc-width) "s"))) (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)))) + (mapcar (lambda (k) (apply #'format col-format k)) + col-keys)))) (defun which-key--partition-list (n list) "Partition LIST into N-sized sublists." commit 55b2440de048f338a1e762afe17e02950b48a0b6 Author: Jonas Bernoulli Date: Sat May 28 00:28:57 2022 +0200 Replace or quote certain single quotes in docstrings The byte-compiler recently got more fussy about quotes. diff --git a/which-key.el b/which-key.el index 19d1f9fb3d1..4eac1bab69c 100644 --- a/which-key.el +++ b/which-key.el @@ -235,7 +235,7 @@ face to apply)." 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\")\)" +\(setq which-key-special-keys \\='(\"SPC\" \"TAB\" \"RET\" \"ESC\" \"DEL\")\)" :group 'which-key :type '(repeat string)) @@ -291,10 +291,10 @@ location is tried." (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 +`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 +`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 @@ -906,7 +906,7 @@ replaced. COMMAND can be nil if the binding corresponds to a key prefix. An example is \(which-key-add-keymap-based-replacements global-map - \"C-x w\" '\(\"Save as\" . write-file\)\). + \"C-x w\" \\='\(\"Save as\" . write-file\)\). For backwards compatibility, REPLACEMENT can also be a string, but the above format is preferred, and the option to use a string @@ -938,7 +938,7 @@ may either be a string, as in a cons of two strings as in \(which-key-add-key-based-replacements \"C-x 8\" - '(\"unicode\" . \"Unicode keys\")\) + \\='(\"unicode\" . \"Unicode keys\")\) or a function that takes a \(KEY . BINDING\) cons and returns a replacement. commit 1ab1d0cc88843c9a614ed3226c5a1070e32e4823 Author: Justin Burkett Date: Wed May 18 15:41:11 2022 -0400 Add group to minor-mode definition Fixes #339 diff --git a/which-key.el b/which-key.el index c9d60b88ca3..19d1f9fb3d1 100644 --- a/which-key.el +++ b/which-key.el @@ -782,6 +782,7 @@ disable support." (define-minor-mode which-key-mode "Toggle which-key-mode." :global t + :group 'which-key :lighter which-key-lighter :keymap (let ((map (make-sparse-keymap))) (mapc commit 129f4ebfc74f207ac82978f6d90d8b4bb1a55cf9 Merge: 1692a1e54f6 1217db8c635 Author: Justin Burkett Date: Mon Apr 18 22:27:45 2022 -0400 Merge remote-tracking branch 'origin/master' commit 1692a1e54f690a07292f0ebab53640178044fd5a Author: Justin Burkett Date: Mon Apr 18 22:26:35 2022 -0400 Add an example to README for keymap binding See #338 diff --git a/README.org b/README.org index 994931813d7..9d9a4c4a57b 100644 --- a/README.org +++ b/README.org @@ -278,17 +278,22 @@ example, #+BEGIN_SRC emacs-lisp - (define-key some-map "f" '("foo" . command-foo)) - (define-key some-map "b" '("bar-prefix" . (keymap))) + (define-key some-map "f" '("foo" . command-foo)) + (define-key some-map "b" '("bar-prefix" . (keymap))) + (setq my-map (make-sparse-keymap)) + (define-key some-map "b" (cons "bar-prefix" my-map)) #+END_SRC binds =command-foo= to =f= in =some-map=, but also stores the string "foo" which which-key will extract to use to describe this command. The second example binds an empty keymap to =b= in =some-map= and uses "bar-prefix" to - describe it. These bindings are accepted by =define-key= natively (i.e., - with or without which-key being loaded). Since many key-binding utilities - use =define-key= internally, this functionality should be available with - your favorite method of defining keys as well. + describe it. The last two lines replicate the functionality of the second + line, while assigning the new keymap to the symbol =my-map= (note the use + of =cons= to ensure that =my-map= is evaluated for =define-key=). These + bindings are accepted by =define-key= natively (i.e., with or without + which-key being loaded). Since many key-binding utilities use =define-key= + internally, this functionality should be available with your favorite + method of defining keys as well. The second method is to use =which-key-add-keymap-based-replacements=. The statement commit 1217db8c6356659e67b35dedd9f5f260c06f6e99 Author: Justin Burkett Date: Mon Feb 14 13:18:32 2022 -0500 Bump version diff --git a/which-key.el b/which-key.el index d2743198fa1..c9d60b88ca3 100644 --- a/which-key.el +++ b/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.5.1 +;; Version: 3.6.0 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit 8d934c571fb954232c4cbe6f1dab554a35ad5e7d Author: Justin Burkett Date: Sun Feb 13 22:33:02 2022 -0500 Don't allow transient maps when prefix length is zero. Fixes #335 diff --git a/which-key.el b/which-key.el index c13f4af25aa..d2743198fa1 100644 --- a/which-key.el +++ b/which-key.el @@ -2655,6 +2655,9 @@ Finally, show the buffer." (not which-key--secondary-timer-active)) (which-key--start-timer which-key-idle-secondary-delay t)))) ((and which-key-show-transient-maps + ;; Assuming that if this is not true we're in + ;; `which-key-show-top-level', which would then be overwritten. + (> (length prefix-keys) 0) (keymapp overriding-terminal-local-map) ;; basic test for it being a hydra (not (eq (lookup-key overriding-terminal-local-map "\C-u") commit 9f64733e4ac563c0cda3685acf4e1c2cf600319b Author: Justin Burkett Date: Sun Jan 2 09:33:02 2022 -0500 Fix typo in ellipsis diff --git a/which-key.el b/which-key.el index 870894644db..c13f4af25aa 100644 --- a/which-key.el +++ b/which-key.el @@ -133,9 +133,9 @@ the default is \" : \"." :group 'which-key :type 'string) -(defcustom which-key-elipsis +(defcustom which-key-ellipsis (if which-key-dont-use-unicode ".." "…") - "Elipsis to use when truncating. Default is \"…\", unless + "Ellipsis to use when truncating. Default is \"…\", unless `which-key-dont-use-unicode' is non nil, in which case the default is \"..\"." :group 'which-key @@ -1589,7 +1589,7 @@ If KEY contains any \"special keys\" defined in (defsubst which-key--truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) - (dots (which-key--propertize which-key-elipsis 'face last-face))) + (dots (which-key--propertize which-key-ellipsis 'face last-face))) (if (and which-key-max-description-length (> (length desc) which-key-max-description-length)) (concat (substring desc 0 which-key-max-description-length) dots) commit 3c0c7c24ef457c1de0ba6f20e2baab02f6c6beaf Merge: 4c82226083e 8361479d78a Author: Justin Burkett Date: Sat Jan 1 23:28:19 2022 -0500 Merge pull request #329 from hans-d/feat-elipsis add which-key-elipsis commit 4c82226083e8fcf0338cd56fd58be99045398d34 Merge: 99a79236ebf 0abac5e0253 Author: Justin Burkett Date: Sat Jan 1 23:26:37 2022 -0500 Merge branch 'feat-columnsize' commit 0abac5e0253f9ae04763958cf30c8e14cd997430 Author: Justin Burkett Date: Sat Jan 1 23:25:59 2022 -0500 Fix code column width diff --git a/which-key.el b/which-key.el index a499e2a8833..644d755c13c 100644 --- a/which-key.el +++ b/which-key.el @@ -1862,7 +1862,8 @@ 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 which-key-min-column-description-width)) + (col-desc-width (which-key--max-len + col-keys 2 which-key-min-column-description-width)) (col-width (+ 1 col-key-width col-sep-width col-desc-width))) (cons col-width (mapcar (lambda (k) commit 99a79236ebfe451fbdd9e71958d5492ca61161b9 Merge: 5f19ec67f58 b432fcf581e Author: Justin Burkett Date: Sat Jan 1 23:11:21 2022 -0500 Merge pull request #331 from skangas/gnu-elpa-badge Add GNU ELPA badge commit b432fcf581e34b4078b0c08b102b90406aad66b1 Author: Stefan Kangas Date: Sat Jan 1 01:38:56 2022 +0100 Add GNU ELPA badge to README.org diff --git a/README.org b/README.org index ea80bfda88a..994931813d7 100644 --- a/README.org +++ b/README.org @@ -1,4 +1,5 @@ * which-key + [[https://elpa.gnu.org/packages/which-key.html][https://elpa.gnu.org/packages/which-key.svg]] [[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]] commit 8361479d78a2c5dcca25a96b5e70164bb521268c Author: Hans Donner Date: Fri Dec 24 20:00:51 2021 +0100 add which-key-elipsis diff --git a/which-key.el b/which-key.el index c71c741ee32..2828224c2fe 100644 --- a/which-key.el +++ b/which-key.el @@ -128,6 +128,15 @@ the default is \" : \"." :group 'which-key :type 'string) +(defcustom which-key-elipsis + (if which-key-dont-use-unicode ".." "…") + "Elipsis to use when truncating. 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 \"+\"." @@ -1575,7 +1584,7 @@ If KEY contains any \"special keys\" defined in (defsubst which-key--truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) - (dots (which-key--propertize ".." 'face last-face))) + (dots (which-key--propertize which-key-elipsis 'face last-face))) (if (and which-key-max-description-length (> (length desc) which-key-max-description-length)) (concat (substring desc 0 which-key-max-description-length) dots) commit 95abb89145cd6c6c1cf7503622e8c2d42232d415 Author: Hans Donner Date: Fri Dec 24 08:26:04 2021 +0100 add which-key-min-column-description-width diff --git a/which-key.el b/which-key.el index c71c741ee32..a499e2a8833 100644 --- a/which-key.el +++ b/which-key.el @@ -93,6 +93,11 @@ Also adds \"..\". If nil, disable any truncation." :group 'which-key :type '(choice integer (const :tag "Disable truncation" nil))) +(defcustom which-key-min-column-description-width 0 + "Every column should at least have this width." + :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." @@ -1843,12 +1848,12 @@ non-nil, then bindings are collected recursively for all prefixes." (rows (apply #'cl-mapcar #'list padded))) (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n"))) -(defsubst which-key--max-len (keys index) +(defsubst which-key--max-len (keys index &optional initial-value) "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)) + keys :initial-value (if initial-value initial-value 0))) (defun which-key--pad-column (col-keys) "Take a column of (key separator description) COL-KEYS, @@ -1857,7 +1862,7 @@ 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-desc-width (which-key--max-len col-keys 2 which-key-min-column-description-width)) (col-width (+ 1 col-key-width col-sep-width col-desc-width))) (cons col-width (mapcar (lambda (k) commit 5f19ec67f58585ab0b8fa713905243ea0de190e0 Author: Justin Burkett Date: Mon Dec 13 21:27:32 2021 -0500 Update to the newer advice API Patch submitted by Stefan Monnier diff --git a/which-key.el b/which-key.el index edbad7a3687..c71c741ee32 100644 --- a/which-key.el +++ b/which-key.el @@ -1,6 +1,6 @@ ;;; which-key.el --- Display available keybindings in popup -*- lexical-binding: t; -*- -;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Copyright (C) 2017-2021 Free Software Foundation, Inc. ;; Author: Justin Burkett ;; Maintainer: Justin Burkett @@ -742,11 +742,10 @@ 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)) +(defun which-key--god-mode-lookup-command-advice (orig-fun arg1 &rest args) + (setq which-key--god-mode-key-string arg1) (unwind-protect - ad-do-it + (apply orig-fun arg1 args) (when (bound-and-true-p which-key-mode) (which-key--hide-popup)))) @@ -758,13 +757,10 @@ 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)) + (advice-remove 'god-mode-lookup-command + #'which-key--god-mode-lookup-command-advice) + (advice-add 'god-mode-lookup-command :around + #'which-key--god-mode-lookup-command-advice))) ;;; Mode @@ -796,7 +792,7 @@ disable support." (add-hook 'pre-command-hook #'which-key--lighter-restore)) (add-hook 'pre-command-hook #'which-key--hide-popup) (add-hook 'window-size-change-functions - 'which-key--hide-popup-on-frame-size-change) + #'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 @@ -805,7 +801,7 @@ disable support." (remove-hook 'pre-command-hook #'which-key--lighter-restore)) (remove-hook 'pre-command-hook #'which-key--hide-popup) (remove-hook 'window-size-change-functions - 'which-key--hide-popup-on-frame-size-change) + #'which-key--hide-popup-on-frame-size-change) (which-key--stop-timer))) (defun which-key--init-buffer () @@ -1561,8 +1557,9 @@ If KEY contains any \"special keys\" defined in `which-key-special-key-face'." (let ((key-w-face (which-key--propertize key 'face 'which-key-key-face)) (regexp (concat "\\(" - (mapconcat 'identity which-key-special-keys - "\\|") "\\)")) + (mapconcat #'identity which-key-special-keys + "\\|") + "\\)")) case-fold-search) (save-match-data (if (and which-key-special-keys @@ -2025,7 +2022,7 @@ max-lines max-width avl-lines avl-width (which-key--pages-height result)) (eval-and-compile (if (fboundp 'universal-argument--description) (defalias 'which-key--universal-argument--description - '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 @@ -2313,7 +2310,7 @@ PREFIX should be a string suitable for `kbd'." (which-key--create-buffer-and-show (apply #'vector key-lst))) (t (setq which-key--automatic-display nil) (which-key-show-top-level))))) -(defalias 'which-key-undo 'which-key-undo-key) +(defalias 'which-key-undo #'which-key-undo-key) (defun which-key-abort (&optional _) "Abort key sequence." @@ -2474,7 +2471,7 @@ KEYMAP is selected interactively by mode in (intern (completing-read "Minor Mode: " - (mapcar 'car + (mapcar #'car (cl-remove-if-not (lambda (entry) (and (symbol-value (car entry)) commit 1bb1f723dab2fc8b88b7f7273d0a7fa11134b936 Author: Justin Burkett Date: Wed Dec 8 23:57:20 2021 -0500 Fix key-chord handling It turns out we don't need to do anything too tricky for key-chords, because this-single-command-raw-keys returns the correct key-sequence Fixes #254 diff --git a/which-key.el b/which-key.el index 0fa2fa39ad7..edbad7a3687 100644 --- a/which-key.el +++ b/which-key.el @@ -2588,22 +2588,11 @@ Finally, show the buffer." (defun which-key--this-command-keys () "Version of `this-single-command-keys' corrected for key-chords and god-mode." (let ((this-command-keys (this-single-command-keys))) - (when (and (equal this-command-keys [key-chord]) + (when (and (vectorp this-command-keys) + (> (length this-command-keys) 0) + (eq (aref this-command-keys 0) 'key-chord) (bound-and-true-p key-chord-mode)) - (setq this-command-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]))))) + (setq this-command-keys (this-single-command-raw-keys))) (when (and which-key--god-mode-support-enabled (bound-and-true-p god-local-mode) (eq this-command 'god-mode-self-insert)) commit 521a59b6f461232a008fba62f79bbb14f487b16e Author: Justin Burkett Date: Thu Nov 25 22:45:35 2021 -0500 Respect which-key-min-display-lines setting Fixes #325 diff --git a/which-key.el b/which-key.el index e55197ee4a0..0fa2fa39ad7 100644 --- a/which-key.el +++ b/which-key.el @@ -1973,6 +1973,13 @@ is the width of the live window." (or prefix-title (which-key--maybe-get-prefix-title (key-description prefix-keys)))) + (when (and (= (which-key--pages-num-pages result) 1) + (> which-key-min-display-lines + (which-key--pages-height result))) + ;; result is shorter than requested, so we artificially increase the + ;; height. See #325. Note this only has an effect if + ;; `which-key-allow-imprecise-window-fit' is non-nil. + (setf (which-key--pages-height result) which-key-min-display-lines)) (which-key--debug-message "Frame height: %s Minibuffer height: %s Max dimensions: (%s,%s) commit 2165957749e4874425b5c03f079b23725b331819 Author: Justin Burkett Date: Thu Nov 25 21:32:18 2021 -0500 Allow binding to symbols in which-key-C-h-dispatch Fixes #326 diff --git a/which-key.el b/which-key.el index 1daebc94241..e55197ee4a0 100644 --- a/which-key.el +++ b/which-key.el @@ -2379,7 +2379,10 @@ prefix) if `which-key-use-C-h-commands' is non nil." " 1..9" which-key-separator "digit-arg")) 'face 'which-key-note-face))) - (key (string (read-key prompt))) + (key (let ((key (read-key prompt))) + (if (numberp key) + (string key) + (vector key)))) (cmd (lookup-key which-key-C-h-map key)) (which-key-inhibit t)) (if cmd (funcall cmd key) (which-key-turn-page 0))))))) commit b73f79170449e53101f8e8c8d6400e9cce0849a2 Merge: a8da8714cd4 9a3e50ee2a7 Author: Justin Burkett Date: Thu Nov 25 21:00:25 2021 -0500 Merge pull request #327 from anis-semmar/patch-1 README.org: fix page flipping command names commit a8da8714cd457009bcbb4be82573765226576f4c Merge: 4790a14683a 507292dfde0 Author: Justin Burkett Date: Thu Nov 25 20:58:22 2021 -0500 Merge pull request #321 from fredericgiquel/preserve-window-configuration Preserve window configuration commit 9a3e50ee2a7fea05ae5c39a464960e003c6902f3 Author: anis-semmar <78486514+anis-semmar@users.noreply.github.com> Date: Thu Nov 18 17:30:41 2021 +0100 README.org: fix page flipping command names `which-key-show-next-page` / `which-key-show-previous-page` do not exist, state the correct command name. diff --git a/README.org b/README.org index 37c742edcce..ea80bfda88a 100644 --- a/README.org +++ b/README.org @@ -175,7 +175,8 @@ - =which-key-show-major-mode= will show the currently active major-mode bindings. It's similar to =C-h m= but in a which-key format. It is also aware of evil commands defined using =evil-define-key=. - - =which-key-show-next-page= is the command used for paging. + - =which-key-show-next-page-cycle= / =which-key-show-previous-page-cycle= will flip pages in a circle. + - =which-key-show-next-page-no-cycle= / =which-key-show-previous-page-no-cycle= will flip pages and stop at first/last page. - =which-key-undo= can be used to undo the last keypress when in the middle of a key sequence. commit 4790a14683a2f3e4f72ade197c78e4c0af1cdd4b Merge: 7a10ff66154 843d1c58bbe Author: Justin Burkett Date: Mon Aug 23 20:11:35 2021 -0400 Merge pull request #323 from Zetagon/master Add missing argument to function call commit 843d1c58bbebb3359732cb88f07e8908487f4d1c Author: Leo Okawa Ericson Date: Mon Aug 23 13:01:01 2021 +0200 Add missing argument to function call diff --git a/which-key.el b/which-key.el index bb007e81eb1..470d173862c 100644 --- a/which-key.el +++ b/which-key.el @@ -1799,7 +1799,7 @@ non-nil, then bindings are collected recursively for all prefixes." (let* ((unformatted (cond ((keymapp keymap) (which-key--get-keymap-bindings - keymap prefix filter recursive)) + keymap nil prefix filter recursive)) (keymap (error "%s is not a keymap" keymap)) (t commit 507292dfde002d9d58c36034427feb8df2f421e1 Author: Frédéric Giquel Date: Wed Aug 18 10:17:28 2021 +0200 Add option (default off) to restore window configuration diff --git a/which-key.el b/which-key.el index 061afee73b8..6bbe2922bea 100644 --- a/which-key.el +++ b/which-key.el @@ -407,6 +407,15 @@ Note that `which-key-idle-delay' should be set before turning on :group 'which-key :type 'boolean) +(defcustom which-key-preserve-window-configuration nil + "If non-nil, save window configuration before which-key buffer is shown +and restore it after which-key buffer is hidden. It prevents which-key from +changing window position of visible buffers. +Only takken into account when popup type is side-window." + :group + 'which-key + :type 'boolean) + (defvar which-key-C-h-map (let ((map (make-sparse-keymap))) (dolist (bind `(("\C-a" . which-key-abort) @@ -1099,7 +1108,8 @@ total height." ;; 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) - (when which-key--saved-window-configuration + (when (and which-key-preserve-window-configuration + which-key--saved-window-configuration) (set-window-configuration which-key--saved-window-configuration) (setq which-key--saved-window-configuration nil)))) @@ -1140,7 +1150,8 @@ call signature in different emacs versions" (defun which-key--show-buffer-side-window (act-popup-dim) "Show which-key buffer when popup type is side-window." - (unless which-key--saved-window-configuration + (when (and which-key-preserve-window-configuration + (not which-key--saved-window-configuration)) (setq which-key--saved-window-configuration (current-window-configuration))) (let* ((height (car act-popup-dim)) (width (cdr act-popup-dim)) commit 7a10ff66154c03f277a009aab8861889cbbe2618 Merge: cc84b2d0da6 31532874651 Author: Justin Burkett Date: Tue Aug 17 13:35:22 2021 -0400 Merge pull request #313 from duncanburke/master Add support for help-char being a generalized input event commit 2042f11eb1c036f3e4dcf3ce447e978b9ee64357 Author: Frédéric Giquel Date: Fri Jul 30 18:06:29 2021 +0200 Preserve window configuration diff --git a/which-key.el b/which-key.el index 9a334ccc1ac..061afee73b8 100644 --- a/which-key.el +++ b/which-key.el @@ -655,6 +655,8 @@ update.") prefix prefix-title) +(defvar which-key--saved-window-configuration nil) + (defun which-key--rotate (list n) (let* ((len (length list)) (n (if (< n 0) (+ len n) n)) @@ -1096,7 +1098,10 @@ total height." (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))) + (quit-windows-on which-key--buffer) + (when which-key--saved-window-configuration + (set-window-configuration which-key--saved-window-configuration) + (setq which-key--saved-window-configuration nil)))) (defun which-key--hide-buffer-frame () "Hide which-key buffer when frame popup is used." @@ -1135,6 +1140,8 @@ call signature in different emacs versions" (defun which-key--show-buffer-side-window (act-popup-dim) "Show which-key buffer when popup type is side-window." + (unless which-key--saved-window-configuration + (setq which-key--saved-window-configuration (current-window-configuration))) (let* ((height (car act-popup-dim)) (width (cdr act-popup-dim)) (alist commit cc84b2d0da629ecb62a92e3fd23cbee4ea20ce56 Merge: 55fcce0c614 5ced0016f6f Author: Justin Burkett Date: Tue Jul 27 21:50:13 2021 -0400 Merge pull request #315 from peniblec/keymap-names Fix some keymap names not showing up commit 5ced0016f6fd44f6318f75367557fa129be36655 Author: Kévin Le Gouguec Date: Sun Jul 18 18:53:14 2021 +0200 Fix some keymap names not showing up Closes #314. diff --git a/which-key-tests.el b/which-key-tests.el index cce75ce4066..1f2b1965ec3 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -44,6 +44,14 @@ ("C-b" . "group:mymap") ("C-c" . "group:mymap2")))))) +(ert-deftest which-key-test--named-prefix-keymap () + (define-prefix-command 'which-key-test--named-map) + (let ((map (make-sparse-keymap))) + (define-key map "\C-a" 'which-key-test--named-map) + (should (equal + (which-key--get-keymap-bindings map) + '(("C-a" . "which-key-test--named-map")))))) + (ert-deftest which-key-test--prefix-declaration () "Test `which-key-declare-prefixes' and `which-key-declare-prefixes-for-mode'. See Bug #109." diff --git a/which-key.el b/which-key.el index 0fdcb7aefb2..9a334ccc1ac 100644 --- a/which-key.el +++ b/which-key.el @@ -1743,8 +1743,8 @@ Requires `which-key-compute-remaps' to be non-nil" (binding (cons key-desc (cond - ((keymapp def) "prefix") ((symbolp def) (which-key--compute-binding def)) + ((keymapp def) "prefix") ((eq 'lambda (car-safe def)) "lambda") ((eq 'closure (car-safe def)) "closure") ((stringp def) def) commit 31532874651bf3268c87601eb7478e1756e220af Author: Duncan Burke Date: Wed Jul 14 01:24:05 2021 +1000 Add support for help-char being a generalized input event Not all keyboard events can be represented as a character. For example, while ?\C-h is a character, represented as 8 in decimal, C-M-h is represented by 134217736 in decimal, as can be obtained from: (elt (kbd "C-M-h") 0) It is useful to allow help-char to be set to something other than a character, as characters cover only a very small region of possible input events. This is especially important because help-char is used to bring up the pagination menu (when which-key-use-C-h-commands is t), and this won't work if it conflicts with any keybinding within the prefix command that led to the activation of which-key. If help-char is left set to ?\C-h things work fine because as a convention keymaps avoid binding that due to it being the default binding for help. That is just a convention, however, and things become more difficult with a heavily user-customized set of keybindings that preclude the use of ?\C-h for that purpose. In that case, if ?\C-h cannot be used, it is much easier to find a binding for help-char that is unlikely to conflict with any bindings if it is permitted to use the full range of modifier keys. This patch modifies which-key--next-page-hint, which is the only place that broke when I set help-char to a keyboard event that wasn't a character. Rather than doing a string comparison, help-char and prefix keys are put in vectors and equality is checked that way. diff --git a/which-key.el b/which-key.el index 0fdcb7aefb2..62f0f6153c5 100644 --- a/which-key.el +++ b/which-key.el @@ -1992,9 +1992,8 @@ max-lines max-width avl-lines avl-width (which-key--pages-height result)) (concat key " or " which-key-paging-key) key))) (when (and which-key-use-C-h-commands - (or (not (stringp (kbd prefix-keys))) - (not (string-equal (char-to-string help-char) - (kbd prefix-keys))))) + (not (equal (vector help-char) + (vconcat (kbd prefix-keys))))) (which-key--propertize (format "[%s paging/help]" key) 'face 'which-key-note-face)))) commit 55fcce0c6143044535bc6825a68f42ca83f58f00 Author: Justin Burkett Date: Mon Jul 12 14:52:52 2021 -0400 Remove more instances of obsolete variables. diff --git a/which-key.el b/which-key.el index a493557ae3a..0fdcb7aefb2 100644 --- a/which-key.el +++ b/which-key.el @@ -185,19 +185,6 @@ non-nil value." :value-type (cons (choice string (const nil)) (choice string (const 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, @@ -843,11 +830,7 @@ 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))) + (setq which-key-separator " : "))) ;;; Default configuration functions for use by users. commit c39c747a0922d78db76bf7bad791b1154395a7f4 Merge: 1e1b7cb6f0b 253751458e6 Author: Justin Burkett Date: Sat Jul 10 21:08:08 2021 -0400 Merge remote-tracking branch 'origin/master' commit 1e1b7cb6f0b17835876ce772e1bce9d43e7cafbb Author: Justin Burkett Date: Sat Jul 10 21:03:55 2021 -0400 Remove some obsolete variables/functions diff --git a/which-key.el b/which-key.el index ff0db279ed7..a493557ae3a 100644 --- a/which-key.el +++ b/which-key.el @@ -140,16 +140,6 @@ 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 . "which-key-show-next-page-no-cycle") . (nil . "wk next pg")) @@ -666,9 +656,6 @@ update.") "select-window" "switch-frame" "-state" "which-key")))) -(make-obsolete-variable 'which-key-prefix-name-alist nil "2016-10-05") -(make-obsolete-variable 'which-key-prefix-title-alist nil "2016-10-05") - (defvar which-key--pages-obj nil) (cl-defstruct which-key--pages pages @@ -1008,22 +995,6 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (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." commit 253751458e66f44a6e7deac83a47eabf3958f064 Author: Justin Burkett Date: Tue Jul 6 10:33:39 2021 -0400 Don't require evil in which-key-tests.el Patch from Stefan Monnier diff --git a/.gitignore b/.gitignore index de0966b3271..5998b430cd1 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,10 @@ *~ *.elc + +# Autogenerated by GNU ELPA scripts +/which-key-autoloads.el +/which-key-pkg.el + # Used to setup library paths for emacs -Q private-test-setup.el /.cask/ diff --git a/which-key-tests.el b/which-key-tests.el index 877f0091964..cce75ce4066 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -1,6 +1,6 @@ ;;; which-key-tests.el --- Tests for which-key.el -*- lexical-binding: t; -*- -;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Copyright (C) 2017-2021 Free Software Foundation, Inc. ;; Author: Justin Burkett ;; Maintainer: Justin Burkett @@ -26,12 +26,11 @@ (require 'which-key) (require 'ert) -(require 'evil) (ert-deftest which-key-test--keymap-based-bindings () (let ((map (make-sparse-keymap)) (prefix-map (make-sparse-keymap))) - (define-key prefix-map "x" 'ignore) + (define-key prefix-map "x" #'ignore) (define-key map "\C-a" 'complete) (define-key map "\C-b" prefix-map) (which-key-add-keymap-based-replacements map @@ -68,8 +67,8 @@ (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) + (test-mode-1 't) + (test-mode-2 'nil) which-key-allow-multiple-replacements) (which-key-add-key-based-replacements "C-c ." "test ." @@ -141,12 +140,16 @@ (should (equal (which-key--extract-key "M-a a .. c") "a .. c"))) (ert-deftest which-key-test--get-keymap-bindings () + (skip-unless (require 'evil nil t)) + (defvar evil-local-mode) + (defvar evil-state) + (declare-function evil-define-key* "ext:evil") (let ((map (make-sparse-keymap)) (evil-local-mode t) (evil-state 'normal) which-key-replacement-alist) (define-key map [which-key-a] '(which-key "blah")) - (define-key map "b" 'ignore) + (define-key map "b" #'ignore) (define-key map "c" "c") (define-key map "dd" "dd") (define-key map "eee" "eee") @@ -198,58 +201,58 @@ (let ((which-key-sort-uppercase-first t)) (should (equal - (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order)) + (mapcar #'car (sort (copy-sequence keys) #'which-key-key-order)) '("SPC" "A" "B" "a" "b" "p" "C-a")))) (let (which-key-sort-uppercase-first) (should (equal - (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order)) + (mapcar #'car (sort (copy-sequence keys) #'which-key-key-order)) '("SPC" "a" "b" "p" "A" "B" "C-a")))) (let ((which-key-sort-uppercase-first t)) (should (equal - (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha)) + (mapcar #'car (sort (copy-sequence keys) #'which-key-key-order-alpha)) '("SPC" "A" "a" "B" "b" "p" "C-a")))) (let (which-key-sort-uppercase-first) (should (equal - (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha)) + (mapcar #'car (sort (copy-sequence keys) #'which-key-key-order-alpha)) '("SPC" "a" "A" "b" "B" "p" "C-a")))) (let ((which-key-sort-uppercase-first t)) (should (equal - (mapcar 'car (sort (copy-sequence keys) - 'which-key-prefix-then-key-order)) + (mapcar #'car (sort (copy-sequence keys) + #'which-key-prefix-then-key-order)) '("SPC" "A" "B" "a" "b" "C-a" "p")))) (let (which-key-sort-uppercase-first) (should (equal - (mapcar 'car (sort (copy-sequence keys) - 'which-key-prefix-then-key-order)) + (mapcar #'car (sort (copy-sequence keys) + #'which-key-prefix-then-key-order)) '("SPC" "a" "b" "A" "B" "C-a" "p")))) (let ((which-key-sort-uppercase-first t)) (should (equal (mapcar 'car (sort (copy-sequence keys) - 'which-key-prefix-then-key-order-reverse)) + #'which-key-prefix-then-key-order-reverse)) '("p" "SPC" "A" "B" "a" "b" "C-a")))) (let (which-key-sort-uppercase-first) (should (equal - (mapcar 'car (sort (copy-sequence keys) - 'which-key-prefix-then-key-order-reverse)) + (mapcar #'car (sort (copy-sequence keys) + #'which-key-prefix-then-key-order-reverse)) '("p" "SPC" "a" "b" "A" "B" "C-a")))) (let ((which-key-sort-uppercase-first t)) (should (equal - (mapcar 'car (sort (copy-sequence keys) - 'which-key-description-order)) + (mapcar #'car (sort (copy-sequence keys) + #'which-key-description-order)) '("p" "C-a" "SPC" "b" "B" "a" "A")))) (let (which-key-sort-uppercase-first) (should (equal - (mapcar 'car (sort (copy-sequence keys) - 'which-key-description-order)) + (mapcar #'car (sort (copy-sequence keys) + #'which-key-description-order)) '("p" "C-a" "SPC" "b" "B" "a" "A")))))) (provide 'which-key-tests) commit 27d9fec33abb989b030f7677ccf5f799287d6472 Author: Justin Burkett Date: Wed Jun 30 08:17:03 2021 -0400 Fix compiler warnings Fixes #312 diff --git a/which-key.el b/which-key.el index 1213d14a833..ff0db279ed7 100644 --- a/which-key.el +++ b/which-key.el @@ -717,9 +717,20 @@ update.") (goto-char (point-max)) (insert "\n" fmt-msg "\n"))))) +(defsubst which-key--safe-lookup-key (keymap key) + "Version of `lookup-key' that allows KEYMAP to be nil. +Also convert numeric results of `lookup-key' to nil. KEY is not +checked." + (when (keymapp keymap) + (let ((result (lookup-key keymap key))) + (when (and result (not (numberp result))) + result)))) + ;;; Third-party library support ;;;; Evil +(defvar evil-state nil) + (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 @@ -1440,15 +1451,6 @@ local bindings coming first. Within these categories order using "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. -Also convert numeric results of `lookup-key' to nil. KEY is not -checked." - (when (keymapp keymap) - (let ((result (lookup-key keymap key))) - (when (and result (not (numberp result))) - result)))) - (defsubst which-key--butlast-string (str) (mapconcat #'identity (butlast (split-string str)) " ")) @@ -1702,7 +1704,7 @@ return the docstring." (t (format "%s %s" current docstring))))) -(defun which-key--format-and-replace (unformatted &optional prefix preserve-full-key) +(defun which-key--format-and-replace (unformatted &optional preserve-full-key) "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)." @@ -1851,7 +1853,7 @@ non-nil, then bindings are collected recursively for all prefixes." (when which-key-sort-order (setq unformatted (sort unformatted which-key-sort-order))) - (which-key--format-and-replace unformatted prefix recursive))) + (which-key--format-and-replace unformatted recursive))) ;;; Functions for laying out which-key buffer pages commit 7abe54fa1d4aa714d9414bc6877ef2124ce126fe Author: Justin Burkett Date: Tue Jun 29 22:35:58 2021 -0400 Handle closure definition type Fixes #311 diff --git a/which-key.el b/which-key.el index 67b185f2c24..1213d14a833 100644 --- a/which-key.el +++ b/which-key.el @@ -1790,11 +1790,15 @@ Requires `which-key-compute-remaps' to be non-nil" ((keymapp def) "prefix") ((symbolp def) (which-key--compute-binding def)) ((eq 'lambda (car-safe def)) "lambda") + ((eq 'closure (car-safe def)) "closure") ((stringp def) def) ((vectorp def) (key-description def)) - ((consp def) (concat (when (keymapp (cdr-safe def)) - "group:") - (car def))) + ((and (consp def) + ;; looking for (STRING . DEFN) + (stringp (car def))) + (concat (when (keymapp (cdr-safe def)) + "group:") + (car def))) (t "unknown"))))) (when (or (null filter) (and (functionp filter) commit 4c27fc0c565cdda58270dae4024ad03a0017de43 Author: Justin Burkett Date: Tue Jun 22 13:20:40 2021 -0400 Improve which-key-add-keymap-based-replacements. Also, teach which-key--safe-lookup-key to handle numeric results. diff --git a/which-key.el b/which-key.el index 8598fa666e1..67b185f2c24 100644 --- a/which-key.el +++ b/which-key.el @@ -909,20 +909,16 @@ For backwards compatibility, REPLACEMENT can also be a string, but the above format is preferred, and the option to use a string for REPLACEMENT will eventually be removed." (while key - (cond ((consp replacement) - (define-key keymap (kbd key) replacement)) - ((stringp replacement) - (let ((binding (lookup-key keymap (kbd key)))) - (if (or (null binding) - (numberp binding)) - ;; using a keymap in case someone intends to make this a - ;; prefix. If they want to bind something else, they will just - ;; end up overriding the prefix map - (define-key keymap (kbd key) - (cons replacement (make-sparse-keymap))) - (define-key keymap (kbd key) (cons replacement binding))))) - (t - (user-error "replacement is neither a cons cell or a string"))) + (let ((def + (cond + ((consp replacement) replacement) + ((stringp replacement) + (cons replacement + (or (which-key--safe-lookup-key keymap (kbd key)) + (make-sparse-keymap)))) + (t + (user-error "replacement is neither a cons cell or a string"))))) + (define-key keymap (kbd key) def)) (setq key (pop more) replacement (pop more)))) (put 'which-key-add-keymap-based-replacements 'lisp-indent-function 'defun) @@ -1445,8 +1441,13 @@ local bindings coming first. Within these categories order using (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))) + "Version of `lookup-key' that allows KEYMAP to be nil. +Also convert numeric results of `lookup-key' to nil. KEY is not +checked." + (when (keymapp keymap) + (let ((result (lookup-key keymap key))) + (when (and result (not (numberp result))) + result)))) (defsubst which-key--butlast-string (str) (mapconcat #'identity (butlast (split-string str)) " ")) commit cd0c48cda2e7cc1d3bc93d3611e267a7d022de8a Author: Justin Burkett Date: Tue Jun 22 11:36:27 2021 -0400 Clarify usage of keymap replacements in docstrings and README diff --git a/README.org b/README.org index 2280f704acf..37c742edcce 100644 --- a/README.org +++ b/README.org @@ -271,37 +271,38 @@ **** Keymap-based replacement Using this method, which-key can display a custom string for a key definition in some keymap. There are two ways to define a keymap-based - replacement. The first is to use - =which-key-add-keymap-based-replacements=. The statement + replacement. The preferred way is to use =define-key= (or a command that + uses =define-key= internally) with a cons cell as the definition. For + example, + + #+BEGIN_SRC emacs-lisp + (define-key some-map "f" '("foo" . command-foo)) + (define-key some-map "b" '("bar-prefix" . (keymap))) + #+END_SRC + + binds =command-foo= to =f= in =some-map=, but also stores the string "foo" + which which-key will extract to use to describe this command. The second + example binds an empty keymap to =b= in =some-map= and uses "bar-prefix" to + describe it. These bindings are accepted by =define-key= natively (i.e., + with or without which-key being loaded). Since many key-binding utilities + use =define-key= internally, this functionality should be available with + your favorite method of defining keys as well. + + The second method is to use =which-key-add-keymap-based-replacements=. The + statement #+BEGIN_SRC emacs-lisp (define-key some-map "f" 'long-command-name-foo) (define-key some-map "b" some-prefix-map) (which-key-add-keymap-based-replacements some-map "f" '("foo" . long-command-name-foo) - ;; or - ;; "f" "foo" (see the docstring) - "b" '("bar-prefix" . (keymap)) - ;; or - ;; "b" "bar-prefix" (see the docstring) - ) + "b" '("bar-prefix" . (keymap))) #+END_SRC uses =define-key= to add two bindings and tells which-key to use the string "foo" in place of "command-foo" and the string "bar-prefix" for an empty - prefix map. =which-key-add-keymap-based-replacements= uses =define-key= to - bind (or rebind) the command, and you may also use =define-key= directly as - follows. - - #+BEGIN_SRC emacs-lisp - (define-key some-map "f" '("foo" . command-foo)) - (define-key some-map "b" '("bar-prefix" . (keymap))) - #+END_SRC - - Here =define-key= uses the natively supported =(NAME . COMMAND)= notation - to simultaneously define a command and give that command a name. Since many - key-binding utilities use =define-key= internally, this functionality - should be available with your favorite method of defining keys as well. + prefix map. =which-key-add-keymap-based-replacements= just uses + =define-key= to bind (or rebind) the command. There are other methods of telling which-key to replace command names, which are described next. The keymap-based replacements should be the most diff --git a/which-key.el b/which-key.el index 3a0ce9753fe..8598fa666e1 100644 --- a/which-key.el +++ b/which-key.el @@ -895,27 +895,19 @@ but more functional." ;;;###autoload (defun which-key-add-keymap-based-replacements (keymap key replacement &rest more) "Replace the description of KEY using REPLACEMENT in KEYMAP. -KEY should take a format suitable for use in -`kbd'. REPLACEMENT is the string to use to describe the -command associated with KEY in the KEYMAP. You may also use a -cons cell of the form \(STRING . COMMAND\) for each REPLACEMENT, -where STRING is the replacement string and COMMAND is a symbol -corresponding to the intended command to be replaced. In the -latter case, which-key will verify the intended command before -performing the replacement. COMMAND should be nil if the binding -corresponds to a key prefix. For example, +KEY should take a format suitable for use in `kbd'. REPLACEMENT +should be a cons cell of the form \(STRING . COMMAND\) for each +REPLACEMENT, where STRING is the replacement string and COMMAND +is a symbol corresponding to the intended command to be +replaced. COMMAND can be nil if the binding corresponds to a key +prefix. An example is \(which-key-add-keymap-based-replacements global-map - \"C-x w\" \"Save as\"\) + \"C-x w\" '\(\"Save as\" . write-file\)\). -and - -\(which-key-add-keymap-based-replacements global-map - \"C-x w\" '\(\"Save as\" . write-file\)\) - -both have the same effect for the \"C-x C-w\" key binding, but -the latter causes which-key to verify that the key sequence is -actually bound to write-file before performing the replacement." +For backwards compatibility, REPLACEMENT can also be a string, +but the above format is preferred, and the option to use a string +for REPLACEMENT will eventually be removed." (while key (cond ((consp replacement) (define-key keymap (kbd key) replacement)) commit eb5a2e3de16dca7286a323bad62b55d3c08349e0 Author: Justin Burkett Date: Tue Jun 22 11:26:11 2021 -0400 Clean up some docstrings diff --git a/which-key.el b/which-key.el index 9a2883dbaa6..3a0ce9753fe 100644 --- a/which-key.el +++ b/which-key.el @@ -254,7 +254,7 @@ disabled by default. Try this to see the effect. :type 'string) (defcustom which-key-show-prefix 'echo - "Whether to and where to display the current prefix sequence. + "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 @@ -266,7 +266,7 @@ and nil. Nil turns the feature off." (const :tag "Hide" nil))) (defcustom which-key-popup-type 'side-window - "Supported types are minibuffer, side-window, frame, and custom." + "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) @@ -274,12 +274,12 @@ and nil. Nil turns the feature off." (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." + "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. + "Maximum number of columns to display in the which-key buffer nil means don't impose a maximum." :group 'which-key :type '(choice integer (const :tag "Unbounded" nil))) @@ -304,25 +304,23 @@ location is tried." 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." +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." + "Maximum width of which-key popup when type is side-window +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. + "Maximum height of which-key popup when type is side-window 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 commit b83c0deca652ee3d42c1501dd09416b2505304b7 Author: Justin Burkett Date: Tue Jun 22 11:22:32 2021 -0400 Clean up which-key--maybe-replace diff --git a/which-key.el b/which-key.el index 2bfbb3975f3..9a2883dbaa6 100644 --- a/which-key.el +++ b/which-key.el @@ -1506,7 +1506,7 @@ local bindings coming first. Within these categories order using (setq key-binding (which-key--replace-in-binding key-binding repl)))) (when found `(replaced . ,key-binding)))) -(defun which-key--maybe-replace (key-binding &optional prefix) +(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'." @@ -1721,17 +1721,13 @@ alists. Returns a list (key separator description)." (local-map (current-local-map)) new-list) (dolist (key-binding unformatted) - (let* ((key (car key-binding)) + (let* ((keys (car key-binding)) (orig-desc (cdr key-binding)) (group (which-key--group-p orig-desc)) - ;; At top-level prefix is nil - (keys (if prefix - (concat (key-description prefix) " " 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) prefix)) + (key-binding (which-key--maybe-replace key-binding)) (final-desc (which-key--propertize-description (cdr key-binding) group local hl-face orig-desc))) (when final-desc commit 6290c9e21710c3ebbcdec795c916994682e07c94 Author: Justin Burkett Date: Tue Jun 22 07:37:04 2021 -0400 Improve which-key-add-keymap-based-bindings Add a test diff --git a/which-key-tests.el b/which-key-tests.el index 40566e73aa4..877f0091964 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -36,11 +36,14 @@ (define-key map "\C-b" prefix-map) (which-key-add-keymap-based-replacements map "C-a" '("mycomplete" . complete) - "C-b" "mymap") + "C-b" "mymap" + "C-c" "mymap2") + (define-key map "\C-ca" 'foo) (should (equal (which-key--get-keymap-bindings map) '(("C-a" . "mycomplete") - ("C-b" . "group:mymap")))))) + ("C-b" . "group:mymap") + ("C-c" . "group:mymap2")))))) (ert-deftest which-key-test--prefix-declaration () "Test `which-key-declare-prefixes' and diff --git a/which-key.el b/which-key.el index 2d81d2e2739..2bfbb3975f3 100644 --- a/which-key.el +++ b/which-key.el @@ -922,8 +922,15 @@ actually bound to write-file before performing the replacement." (cond ((consp replacement) (define-key keymap (kbd key) replacement)) ((stringp replacement) - (define-key keymap (kbd key) (cons replacement - (lookup-key keymap (kbd key))))) + (let ((binding (lookup-key keymap (kbd key)))) + (if (or (null binding) + (numberp binding)) + ;; using a keymap in case someone intends to make this a + ;; prefix. If they want to bind something else, they will just + ;; end up overriding the prefix map + (define-key keymap (kbd key) + (cons replacement (make-sparse-keymap))) + (define-key keymap (kbd key) (cons replacement binding))))) (t (user-error "replacement is neither a cons cell or a string"))) (setq key (pop more) commit 28f386cc4af8c0fe21269bb587a5bb229ba3834e Author: Justin Burkett Date: Mon Jun 21 23:34:18 2021 -0400 Fix key sort order functions We now always get the full key description (prefix + binding) diff --git a/which-key.el b/which-key.el index 13c440d68ba..2d81d2e2739 100644 --- a/which-key.el +++ b/which-key.el @@ -1343,7 +1343,9 @@ width) in lines and characters respectively." "Sorting function used for `which-key-key-order' and `which-key-key-order-alpha'." (save-match-data - (let* ((rngrgxp "^\\([^ ]+\\) \\.\\. [^ ]+") + (let* ((a (which-key--extract-key a)) + (b (which-key--extract-key b)) + (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 "")) commit d8445fd80e81b6ad2acdb5be2e36740e6d4839d7 Author: Justin Burkett Date: Mon Jun 21 23:10:22 2021 -0400 Try again to fix tests diff --git a/which-key-tests.el b/which-key-tests.el index e2cd0ef6e3d..40566e73aa4 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -26,6 +26,7 @@ (require 'which-key) (require 'ert) +(require 'evil) (ert-deftest which-key-test--keymap-based-bindings () (let ((map (make-sparse-keymap)) @@ -141,7 +142,6 @@ (evil-local-mode t) (evil-state 'normal) which-key-replacement-alist) - (require 'evil) (define-key map [which-key-a] '(which-key "blah")) (define-key map "b" 'ignore) (define-key map "c" "c") commit 7cfbf8cee74ec92bf1a4177323bead288a8dff16 Author: Justin Burkett Date: Mon Jun 21 23:03:20 2021 -0400 Turn off fail-fast in github action diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 87331b72025..6b4d511a8af 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -11,6 +11,7 @@ jobs: build: runs-on: ubuntu-latest strategy: + fail-fast: false matrix: emacs_version: - 26.1 commit 6ae80f50af838ff2bcf6448a55366fb37fb20682 Author: Justin Burkett Date: Mon Jun 21 22:55:33 2021 -0400 Try without cask diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index f764d3202fd..87331b72025 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -20,21 +20,11 @@ jobs: - 27.2 - snapshot steps: - - name: Install Python - uses: actions/setup-python@v2 - with: - python-version: '3.6' - architecture: 'x64' - uses: purcell/setup-emacs@master with: version: ${{ matrix.emacs_version }} - - uses: actions/checkout@v2 - - name: Install Cask - uses: conao3/setup-cask@master - with: - version: 'snapshot' - name: Install dependencies - run: 'cask install' + run: 'git clone https://github.com/emacs-evil/evil' - name: Run tests - run: 'cask exec emacs -Q -batch -L . -l which-key-tests.el -f ert-run-tests-batch-and-exit' + run: 'emacs -Q -batch -L . -L ./evil -l which-key-tests.el -f ert-run-tests-batch-and-exit' commit 11471fb73804fbe6b2bc19f2a1133f4a46853e20 Author: Justin Burkett Date: Mon Jun 21 22:40:54 2021 -0400 Add install python step to github action diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 5b3078c3266..f764d3202fd 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -20,16 +20,21 @@ jobs: - 27.2 - snapshot steps: - - uses: purcell/setup-emacs@master - with: - version: ${{ matrix.emacs_version }} + - name: Install Python + uses: actions/setup-python@v2 + with: + python-version: '3.6' + architecture: 'x64' + - uses: purcell/setup-emacs@master + with: + version: ${{ matrix.emacs_version }} - - uses: actions/checkout@v2 - - name: Install Cask - uses: conao3/setup-cask@master - with: - version: 'snapshot' - - name: Install dependencies - run: 'cask install' - - name: Run tests - run: 'cask exec emacs -Q -batch -L . -l which-key-tests.el -f ert-run-tests-batch-and-exit' + - uses: actions/checkout@v2 + - name: Install Cask + uses: conao3/setup-cask@master + with: + version: 'snapshot' + - name: Install dependencies + run: 'cask install' + - name: Run tests + run: 'cask exec emacs -Q -batch -L . -l which-key-tests.el -f ert-run-tests-batch-and-exit' commit 3f76f5178d28e3b45c236ca83c37613851598abd Author: Justin Burkett Date: Mon Jun 21 22:32:23 2021 -0400 Fix which-key--group-p length> is a new function maybe diff --git a/which-key.el b/which-key.el index 2c4004f950d..13c440d68ba 100644 --- a/which-key.el +++ b/which-key.el @@ -1406,8 +1406,7 @@ Uses `string-lessp' after applying lowercase." (defsubst which-key--group-p (description) (or (string-equal description "prefix") - (and (length> description 6) - (string-equal (substring description 0 6) "group:")) + (string-match-p "^group:" description) (keymapp (intern description)))) (defun which-key-prefix-then-key-order (acons bcons) commit d621634eb606ab68b718f1eeda71bff2763733ca Author: Justin Burkett Date: Mon Jun 21 22:25:15 2021 -0400 Try with cask again diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index c2f1491cbb9..5b3078c3266 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -25,11 +25,11 @@ jobs: version: ${{ matrix.emacs_version }} - uses: actions/checkout@v2 - - name: Install cask - run: | - git clone https://github.com/cask/cask ~/.cask - echo "${HOME}/.cask/bin" >> $GITHUB_PATH + - name: Install Cask + uses: conao3/setup-cask@master + with: + version: 'snapshot' - name: Install dependencies run: 'cask install' - name: Run tests - run: 'emacs -Q -batch -L . -l which-key-tests.el -f ert-run-tests-batch-and-exit' + run: 'cask exec emacs -Q -batch -L . -l which-key-tests.el -f ert-run-tests-batch-and-exit' diff --git a/Cask b/Cask index 6ff7bbe21da..31a9ca10f9d 100644 --- a/Cask +++ b/Cask @@ -4,5 +4,4 @@ (package-file "which-key.el") (development - (depends-on "evil") - (depends-on "ert")) + (depends-on "evil")) commit 063b8670305527f027c4ddeb7861f4ad7f6ca2a5 Author: Justin Burkett Date: Mon Jun 21 22:15:34 2021 -0400 Fix github action diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 3ae62889444..c2f1491cbb9 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -13,12 +13,11 @@ jobs: strategy: matrix: emacs_version: - - 25.1 - - 25.2 - - 25.3 - 26.1 - 26.2 - 26.3 + - 27.1 + - 27.2 - snapshot steps: - uses: purcell/setup-emacs@master @@ -26,5 +25,11 @@ jobs: version: ${{ matrix.emacs_version }} - uses: actions/checkout@v2 + - name: Install cask + run: | + git clone https://github.com/cask/cask ~/.cask + echo "${HOME}/.cask/bin" >> $GITHUB_PATH + - name: Install dependencies + run: 'cask install' - name: Run tests run: 'emacs -Q -batch -L . -l which-key-tests.el -f ert-run-tests-batch-and-exit' commit 7d344ce9661549f9b516ac4c308ec7b8d53aaf51 Author: Justin Burkett Date: Mon Jun 21 16:02:45 2021 -0400 Fix test diff --git a/which-key-tests.el b/which-key-tests.el index 705099b0603..e2cd0ef6e3d 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -39,7 +39,7 @@ (should (equal (which-key--get-keymap-bindings map) '(("C-a" . "mycomplete") - ("C-b" . "mymap")))))) + ("C-b" . "group:mymap")))))) (ert-deftest which-key-test--prefix-declaration () "Test `which-key-declare-prefixes' and commit 300c098be55d78d5d94da59da0280a8a56cc3792 Author: Justin Burkett Date: Mon Jun 21 15:57:40 2021 -0400 Update README diff --git a/README.org b/README.org index 3064466a558..2280f704acf 100644 --- a/README.org +++ b/README.org @@ -3,6 +3,11 @@ [[http://stable.melpa.org/#/which-key][file:http://stable.melpa.org/packages/which-key-badge.svg]] ** Recent Changes +*** 2021-06-21: Add support for menu-item bindings + =which-key= will now detect and compute the result of =menu-item= + bindings. As a consequence of reworking the internals, + =which-key-enable-extended-define-key= is now obsolete (the associated + behavior is supported by default). *** 2020-08-28: Added =which-key-add-keymap-based-replacements= This function provides an alternative interface allowing replacements to be @@ -34,6 +39,7 @@ ** Table of Contents :TOC_3: - [[#which-key][which-key]] - [[#recent-changes][Recent Changes]] + - [[#2021-06-21-add-support-for-menu-item-bindings][2021-06-21: Add support for menu-item bindings]] - [[#2020-08-28-added-which-key-add-keymap-based-replacements][2020-08-28: Added =which-key-add-keymap-based-replacements=]] - [[#2019-08-01-added-which-key-show-early-on-c-h][2019-08-01: Added =which-key-show-early-on-C-h=]] - [[#2017-12-13-added-which-key-enable-extended-define-key][2017-12-13: Added =which-key-enable-extended-define-key=]] @@ -275,30 +281,26 @@ "f" '("foo" . long-command-name-foo) ;; or ;; "f" "foo" (see the docstring) - "b" '("bar-prefix") + "b" '("bar-prefix" . (keymap)) ;; or ;; "b" "bar-prefix" (see the docstring) ) #+END_SRC uses =define-key= to add two bindings and tells which-key to use the string - "foo" in place of "command-foo" and the string "bar-prefix" for - some-prefix-map. Note that =which-key-add-keymap-based-replacements= will - not bind a command, so =define-key= must still be used. - - Alternatively, you may set =which-key-enable-extended-define-key= to =t= - before loading which-key and accomplish the same effect using only - =define-key= as follows. + "foo" in place of "command-foo" and the string "bar-prefix" for an empty + prefix map. =which-key-add-keymap-based-replacements= uses =define-key= to + bind (or rebind) the command, and you may also use =define-key= directly as + follows. #+BEGIN_SRC emacs-lisp (define-key some-map "f" '("foo" . command-foo)) - (define-key some-map "b" '("bar-prefix")) + (define-key some-map "b" '("bar-prefix" . (keymap))) #+END_SRC - The option =which-key-enable-extended-define-key= advises =define-key= to - allow which-key to use the =(NAME . COMMAND)= notation to simultaneously - define a command and give that command a name using =define-key=. Since - many key-binding utilities use =define-key= internally, this functionality + Here =define-key= uses the natively supported =(NAME . COMMAND)= notation + to simultaneously define a command and give that command a name. Since many + key-binding utilities use =define-key= internally, this functionality should be available with your favorite method of defining keys as well. There are other methods of telling which-key to replace command names, commit 8b707ef6c51808e944f8056b546ceb168a445079 Author: Justin Burkett Date: Mon Jun 21 15:51:22 2021 -0400 Make enable-extended-define-key obsolete diff --git a/which-key.el b/which-key.el index c133bebdab9..2c4004f950d 100644 --- a/which-key.el +++ b/which-key.el @@ -522,6 +522,11 @@ it." :group 'which-key :type 'boolean) +(make-obsolete-variable + 'which-key-enable-extended-define-key + "which-key-enable-extended-define-key is obsolete and has no effect." + "2021-06-21") + ;; Hooks (defcustom which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized." commit e236920b231ee1d86ae215598f7a9d8294467310 Merge: 1f9c37d50f0 d6b56f3e0c0 Author: Justin Burkett Date: Mon Jun 21 15:47:10 2021 -0400 Merge branch 'alt-get-bindings' commit d6b56f3e0c0295578db9b88330f1dee38156855e Author: Justin Burkett Date: Mon Jun 21 15:44:07 2021 -0400 Fix detection of named prefix bindings diff --git a/which-key.el b/which-key.el index ebed572255a..831e7d51a92 100644 --- a/which-key.el +++ b/which-key.el @@ -1401,7 +1401,9 @@ Uses `string-lessp' after applying lowercase." (string-lessp (downcase (cdr acons)) (downcase (cdr bcons)))) (defsubst which-key--group-p (description) - (or (equal description "prefix") + (or (string-equal description "prefix") + (and (length> description 6) + (string-equal (substring description 0 6) "group:")) (keymapp (intern description)))) (defun which-key-prefix-then-key-order (acons bcons) @@ -1789,11 +1791,11 @@ Requires `which-key-compute-remaps' to be non-nil" ((keymapp def) "prefix") ((symbolp def) (which-key--compute-binding def)) ((eq 'lambda (car-safe def)) "lambda") - ((eq 'menu-item (car-safe def)) - (which-key--get-menu-item-binding def)) ((stringp def) def) ((vectorp def) (key-description def)) - ((consp def) (car def)) + ((consp def) (concat (when (keymapp (cdr-safe def)) + "group:") + (car def))) (t "unknown"))))) (when (or (null filter) (and (functionp filter) commit 244483334044ebd87a10608eae124111c8837823 Author: Justin Burkett Date: Mon Jun 21 15:07:36 2021 -0400 Fix menu-item bidning retrieval diff --git a/which-key.el b/which-key.el index 55e65b884f3..ebed572255a 100644 --- a/which-key.el +++ b/which-key.el @@ -1745,6 +1745,14 @@ Requires `which-key-compute-remaps' to be non-nil" (copy-sequence (symbol-name remap)) (copy-sequence (symbol-name binding))))) +(defun which-key--get-menu-item-binding (def) + "Retrieve binding for menu-item" + ;; see `keymap--menu-item-binding' + (let* ((binding (nth 2 def)) + (plist (nthcdr 3 def)) + (filter (plist-get plist :filter))) + (if filter (funcall filter binding) binding))) + (defun which-key--get-keymap-bindings-1 (keymap start &optional prefix filter all ignore-commands) "See `which-key--get-keymap-bindings'." @@ -1772,14 +1780,17 @@ Requires `which-key-compute-remaps' to be non-nil" (which-key--get-keymap-bindings-1 keymap bindings key nil all ignore-commands))) (def - (let ((binding + (let* ((def (if (eq 'menu-item (car-safe def)) + (which-key--get-menu-item-binding def) + def)) + (binding (cons key-desc (cond ((keymapp def) "prefix") ((symbolp def) (which-key--compute-binding def)) ((eq 'lambda (car-safe def)) "lambda") ((eq 'menu-item (car-safe def)) - (keymap--menu-item-binding def)) + (which-key--get-menu-item-binding def)) ((stringp def) def) ((vectorp def) (key-description def)) ((consp def) (car def)) commit e42d946cd98f914a0e9c31fe6cb677305a9f2d30 Author: Justin Burkett Date: Mon Jun 21 14:55:05 2021 -0400 Fix prefix sorting diff --git a/which-key-tests.el b/which-key-tests.el index 04617377999..705099b0603 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -189,7 +189,7 @@ ("A" . "Z") ("b" . "y") ("B" . "Y") - ("p" . "Prefix") + ("p" . "prefix") ("SPC" . "x") ("C-a" . "w")))) (let ((which-key-sort-uppercase-first t)) diff --git a/which-key.el b/which-key.el index ec3f760159b..55e65b884f3 100644 --- a/which-key.el +++ b/which-key.el @@ -1401,7 +1401,8 @@ Uses `string-lessp' after applying lowercase." (string-lessp (downcase (cdr acons)) (downcase (cdr bcons)))) (defsubst which-key--group-p (description) - (keymapp (intern description))) + (or (equal description "prefix") + (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 commit 465d2fb2e4540257ad515f37f2cb4e419b286f8c Author: Justin Burkett Date: Mon Jun 21 14:46:51 2021 -0400 Fix add-keymap-based-bindings and associated test diff --git a/which-key-tests.el b/which-key-tests.el index eeedb557370..04617377999 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -29,20 +29,17 @@ (ert-deftest which-key-test--keymap-based-bindings () (let ((map (make-sparse-keymap)) - (emacs-lisp-mode-map (copy-keymap emacs-lisp-mode-map))) - (emacs-lisp-mode) - (define-key map "x" 'ignore) - (define-key emacs-lisp-mode-map "\C-c\C-a" 'complete) - (define-key emacs-lisp-mode-map "\C-c\C-b" map) - (which-key-add-keymap-based-replacements emacs-lisp-mode-map - "C-c C-a" '("mycomplete" . complete) - "C-c C-b" "mymap") - (should (equal - (which-key--maybe-replace '("C-c C-a" . "complete")) - '("C-c C-a" . "mycomplete"))) - (should (equal - (which-key--maybe-replace '("C-c C-b" . "")) - '("C-c C-b" . "mymap"))))) + (prefix-map (make-sparse-keymap))) + (define-key prefix-map "x" 'ignore) + (define-key map "\C-a" 'complete) + (define-key map "\C-b" prefix-map) + (which-key-add-keymap-based-replacements map + "C-a" '("mycomplete" . complete) + "C-b" "mymap") + (should (equal + (which-key--get-keymap-bindings map) + '(("C-a" . "mycomplete") + ("C-b" . "mymap")))))) (ert-deftest which-key-test--prefix-declaration () "Test `which-key-declare-prefixes' and diff --git a/which-key.el b/which-key.el index d6baa70b537..ec3f760159b 100644 --- a/which-key.el +++ b/which-key.el @@ -914,11 +914,13 @@ both have the same effect for the \"C-x C-w\" key binding, but the latter causes which-key to verify that the key sequence is actually bound to write-file before performing the replacement." (while key - (let ((string (if (stringp replacement) - replacement - (car-safe replacement))) - (command (cdr-safe replacement))) - (define-key keymap (kbd key) (cons string command))) + (cond ((consp replacement) + (define-key keymap (kbd key) replacement)) + ((stringp replacement) + (define-key keymap (kbd key) (cons replacement + (lookup-key keymap (kbd key))))) + (t + (user-error "replacement is neither a cons cell or a string"))) (setq key (pop more) replacement (pop more)))) (put 'which-key-add-keymap-based-replacements 'lisp-indent-function 'defun) commit 8d6d81da4c7be4c929e908b1737dfd6d4c2aaa63 Author: Justin Burkett Date: Mon Jun 21 14:35:04 2021 -0400 Expand get-keymap-bindings test diff --git a/Cask b/Cask index 60fa07cbdf2..6ff7bbe21da 100644 --- a/Cask +++ b/Cask @@ -4,4 +4,5 @@ (package-file "which-key.el") (development + (depends-on "evil") (depends-on "ert")) diff --git a/which-key-tests.el b/which-key-tests.el index 17d5d0d4944..eeedb557370 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -141,24 +141,41 @@ (ert-deftest which-key-test--get-keymap-bindings () (let ((map (make-sparse-keymap)) + (evil-local-mode t) + (evil-state 'normal) which-key-replacement-alist) + (require 'evil) (define-key map [which-key-a] '(which-key "blah")) (define-key map "b" 'ignore) (define-key map "c" "c") (define-key map "dd" "dd") (define-key map "eee" "eee") (define-key map "f" [123 45 6]) + (define-key map (kbd "M-g g") "M-gg") + (evil-define-key* 'normal map (kbd "C-h") "C-h-normal") + (evil-define-key* 'insert map (kbd "C-h") "C-h-insert") (should (equal (sort (which-key--get-keymap-bindings map) (lambda (a b) (string-lessp (car a) (car b)))) - '(("c" . "c") + '(("M-g" . "prefix") + ("c" . "c") + ("d" . "prefix") + ("e" . "prefix") + ("f" . "{ - C-f")))) + (should (equal + (sort (which-key--get-keymap-bindings map nil nil nil nil t) + (lambda (a b) (string-lessp (car a) (car b)))) + '(("C-h" . "C-h-normal") + ("M-g" . "prefix") + ("c" . "c") ("d" . "prefix") ("e" . "prefix") ("f" . "{ - C-f")))) (should (equal (sort (which-key--get-keymap-bindings map nil nil nil t) (lambda (a b) (string-lessp (car a) (car b)))) - '(("c" . "c") + '(("M-g g" . "M-gg") + ("c" . "c") ("d d" . "dd") ("e e e" . "eee") ("f" . "{ - C-f")))))) commit 4e592ed7b913aecd13ce8d4e316ca4f8e2f34d7c Author: Justin Burkett Date: Mon Jun 21 14:09:18 2021 -0400 Fix type usage and arglists for new functions diff --git a/which-key.el b/which-key.el index bb1cf01ba45..d6baa70b537 100644 --- a/which-key.el +++ b/which-key.el @@ -1399,8 +1399,7 @@ 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)))) + (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 @@ -1739,19 +1738,19 @@ alists. Returns a list (key separator description)." Requires `which-key-compute-remaps' to be non-nil" (let (remap) (if (and which-key-compute-remaps - (setq remap (command-remapping (intern binding)))) + (setq remap (command-remapping binding))) (copy-sequence (symbol-name remap)) (copy-sequence (symbol-name binding))))) (defun which-key--get-keymap-bindings-1 - "Helper function for `which-key--get-keymap-bindings'" - (keymap start &optional prefix all ignore-commands) + (keymap start &optional prefix filter all ignore-commands) + "See `which-key--get-keymap-bindings'." (let ((bindings start) (prefix-map (if prefix (lookup-key keymap prefix) keymap))) (when (keymapp prefix-map) (map-keymap (lambda (ev def) - (let* ((key (append prefix (list ev))) + (let* ((key (vconcat prefix (list ev))) (key-desc (key-description key))) (cond ((assoc key-desc bindings)) @@ -1768,25 +1767,29 @@ Requires `which-key-compute-remaps' to be non-nil" (and (numberp ev) (= ev 27)))) (setq bindings (which-key--get-keymap-bindings-1 - keymap bindings key all ignore-commands))) + keymap bindings key nil all ignore-commands))) (def - (push - (cons key-desc - (cond - ((keymapp def) "+prefix") - ((symbolp def) (which-key--compute-binding def)) - ((eq 'lambda (car-safe def)) "lambda") - ((eq 'menu-item (car-safe def)) - (keymap--menu-item-binding def)) - ((stringp def) def) - ((vectorp def) (key-description def)) - ((consp def) (car def)) - (t "unknown"))) - bindings))))) + (let ((binding + (cons key-desc + (cond + ((keymapp def) "prefix") + ((symbolp def) (which-key--compute-binding def)) + ((eq 'lambda (car-safe def)) "lambda") + ((eq 'menu-item (car-safe def)) + (keymap--menu-item-binding def)) + ((stringp def) def) + ((vectorp def) (key-description def)) + ((consp def) (car def)) + (t "unknown"))))) + (when (or (null filter) + (and (functionp filter) + (funcall filter binding))) + (push binding bindings))))))) prefix-map)) bindings)) -(defun which-key--get-keymap-bindings (keymap &optional prefix start all evil) +(defun which-key--get-keymap-bindings + (keymap &optional start prefix filter all evil) "Retrieve top-level bindings from KEYMAP. PREFIX limits bindings to those starting with this key sequence. START is a list of existing bindings to add to. If ALL @@ -1799,16 +1802,18 @@ EVIL is non-nil, extract active evil bidings." (lookup-key keymap (kbd (format "<%s-state>" evil-state)))))) (when (keymapp evil-map) (setq bindings (which-key--get-keymap-bindings-1 - evil-map bindings prefix all ignore))) - (which-key--get-keymap-bindings-1 keymap bindings prefix all ignore))) + evil-map bindings prefix filter all ignore))) + (which-key--get-keymap-bindings-1 + keymap bindings prefix filter all ignore))) -(defun which-key--get-current-bindings (&optional prefix) +(defun which-key--get-current-bindings (&optional prefix filter) "Generate a list of current active bindings." (let (bindings) (dolist (map (current-active-maps t) bindings) (when (cdr map) (setq bindings - (which-key--get-keymap-bindings map prefix bindings)))))) + (which-key--get-keymap-bindings + map bindings prefix filter)))))) (defun which-key--get-bindings (&optional prefix keymap filter recursive) "Collect key bindings. @@ -1818,13 +1823,12 @@ is a function to use to filter the bindings. If RECURSIVE is non-nil, then bindings are collected recursively for all prefixes." (let* ((unformatted (cond ((keymapp keymap) - (which-key--get-keymap-bindings keymap recursive)) + (which-key--get-keymap-bindings + keymap prefix filter recursive)) (keymap (error "%s is not a keymap" keymap)) (t - (which-key--get-current-bindings prefix))))) - (when filter - (setq unformatted (cl-remove-if-not filter unformatted))) + (which-key--get-current-bindings prefix filter))))) (when which-key-sort-order (setq unformatted (sort unformatted which-key-sort-order))) commit fffd3e5ebfbd5a38f1f78197452c13330762dc9a Author: Justin Burkett Date: Mon Jun 21 14:00:54 2021 -0400 Fix default of which-key-replacement-alist diff --git a/which-key.el b/which-key.el index 5c2ca802f74..bb1cf01ba45 100644 --- a/which-key.el +++ b/which-key.el @@ -152,9 +152,7 @@ remapped given the currently active keymaps." (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")) + `(((nil . "which-key-show-next-page-no-cycle") . (nil . "wk next pg")) ,@(unless which-key-dont-use-unicode '((("") . ("←")) (("") . ("→")))) commit 8a558e6a794da76f689f8404f9e7e8d030cfb49c Author: Justin Burkett Date: Mon Jun 21 13:59:56 2021 -0400 Update tests diff --git a/which-key-tests.el b/which-key-tests.el index 1611d51cc04..17d5d0d4944 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -151,16 +151,14 @@ (should (equal (sort (which-key--get-keymap-bindings map) (lambda (a b) (string-lessp (car a) (car b)))) - '(("b" . "ignore") - ("c" . "c") - ("d" . "Prefix Command") - ("e" . "Prefix Command") + '(("c" . "c") + ("d" . "prefix") + ("e" . "prefix") ("f" . "{ - C-f")))) (should (equal - (sort (which-key--get-keymap-bindings map t) + (sort (which-key--get-keymap-bindings map nil nil nil t) (lambda (a b) (string-lessp (car a) (car b)))) - '(("b" . "ignore") - ("c" . "c") + '(("c" . "c") ("d d" . "dd") ("e e e" . "eee") ("f" . "{ - C-f")))))) commit fc8855187f087635de4162071882405861460e05 Author: Justin Burkett Date: Mon Jun 21 13:35:38 2021 -0400 Remove pseudo binding stuff It's not necessary anymore with manual parsing of the keymaps diff --git a/which-key.el b/which-key.el index e6ac0c4f19a..5c2ca802f74 100644 --- a/which-key.el +++ b/which-key.el @@ -525,24 +525,6 @@ it." :group 'which-key :type 'boolean) -(defcustom which-key-enable-extended-define-key nil - "Advise `define-key' to make which-key aware of definitions of the form - - \(define-key KEYMAP KEY '(\"DESCRIPTION\" . DEF)) - -With the advice, this definition will have the side effect of -creating a replacement in `which-key-replacement-alist' that -replaces DEF with DESCRIPTION when the key sequence ends in -KEY. Using a cons cell like this is a valid definition for -`define-key'. All this does is to make which-key aware of it. - -Since many higher level keybinding functions use `define-key' -internally, this will affect most if not all of those as well. - -This variable must be set before loading which-key." - :group 'which-key - :type 'boolean) - ;; Hooks (defcustom which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized." @@ -938,8 +920,7 @@ actually bound to write-file before performing the replacement." replacement (car-safe replacement))) (command (cdr-safe replacement))) - (define-key keymap (which-key--pseudo-key (kbd key)) - `(which-key ,(cons string command)))) + (define-key keymap (kbd key) (cons string command))) (setq key (pop more) replacement (pop more)))) (put 'which-key-add-keymap-based-replacements 'lisp-indent-function 'defun) @@ -1044,19 +1025,6 @@ If AT-ROOT is non-nil the binding is also placed at the root of MAP." (which-key-define-key-recursively df key def t))) map)) -(defun which-key--process-define-key-args (keymap key def) - "When DEF takes the form (\"DESCRIPTION\". DEF), make sure -which-key uses \"DESCRIPTION\" for this binding. This function is -meant to be used as :before advice for `define-key'." - (with-demoted-errors "Which-key extended define-key error: %s" - (when (and (consp def) - (stringp (car def)) - (symbolp (cdr def))) - (define-key keymap (which-key--pseudo-key key) `(which-key ,def))))) - -(when which-key-enable-extended-define-key - (advice-add #'define-key :before #'which-key--process-define-key-args)) - ;;; Functions for computing window sizes (defun which-key--text-width-to-total (text-width) @@ -1493,20 +1461,6 @@ local bindings coming first. Within these categories order using (string-match-p binding-regexp (cdr key-binding))))))) -(defun which-key--get-pseudo-binding (key-binding &optional prefix) - (let* ((key (kbd (car key-binding))) - (pseudo-binding (key-binding (which-key--pseudo-key key prefix)))) - (when pseudo-binding - (let* ((command-replacement (cadr pseudo-binding)) - (pseudo-desc (car command-replacement)) - (pseudo-def (cdr command-replacement))) - (when (and (stringp pseudo-desc) - (or (null pseudo-def) - ;; don't verify keymaps - (keymapp pseudo-def) - (eq pseudo-def (key-binding key)))) - (cons (car key-binding) pseudo-desc)))))) - (defsubst which-key--replace-in-binding (key-binding repl) (cond ((or (not (consp repl)) (null (cdr repl))) key-binding) @@ -1542,26 +1496,23 @@ local bindings coming first. Within these categories order using "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* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix))) - (if pseudo-binding - pseudo-binding - (let* ((replacer (if which-key-allow-multiple-replacements - #'which-key--replace-in-repl-list-many - #'which-key--replace-in-repl-list-once))) - (pcase - (apply replacer - (list key-binding - (cdr-safe (assq major-mode which-key-replacement-alist)))) - (`(replaced . ,repl) - (if which-key-allow-multiple-replacements - (pcase (apply replacer (list repl which-key-replacement-alist)) - (`(replaced . ,repl) repl) - ('() repl)) - repl)) - ('() - (pcase (apply replacer (list key-binding which-key-replacement-alist)) + (let* ((replacer (if which-key-allow-multiple-replacements + #'which-key--replace-in-repl-list-many + #'which-key--replace-in-repl-list-once))) + (pcase + (apply replacer + (list key-binding + (cdr-safe (assq major-mode which-key-replacement-alist)))) + (`(replaced . ,repl) + (if which-key-allow-multiple-replacements + (pcase (apply replacer (list repl which-key-replacement-alist)) (`(replaced . ,repl) repl) - ('() key-binding)))))))) + ('() repl)) + repl)) + ('() + (pcase (apply replacer (list key-binding which-key-replacement-alist)) + (`(replaced . ,repl) repl) + ('() key-binding)))))) (defsubst which-key--current-key-list (&optional key-str) (append (listify-key-sequence (which-key--current-prefix)) @@ -1593,12 +1544,6 @@ which are strings. KEY is of the form produced by `key-binding'." (or (eq lookup (intern (cdr keydesc))) (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command")))))) -(defun which-key--pseudo-key (key &optional prefix) - "Replace the last key in the sequence KEY by a special symbol -in order for which-key to allow looking up a description for the key." - (let ((seq (listify-key-sequence key))) - (vconcat (or prefix (butlast seq)) [which-key] (last seq)))) - (defun which-key--maybe-get-prefix-title (keys) "KEYS is a string produced by `key-description'. A title is possibly returned using commit a55b90844c837e157c289ad4b10f5f2e3a4d53ff Author: Justin Burkett Date: Mon Jun 21 12:10:08 2021 -0400 Alternative approach to retrieving bindings (WIP) diff --git a/which-key.el b/which-key.el index 9b4005a8d78..e6ac0c4f19a 100644 --- a/which-key.el +++ b/which-key.el @@ -1790,57 +1790,6 @@ alists. Returns a list (key separator description)." new-list)))) (nreverse new-list))) -(defun which-key--get-keymap-bindings (keymap &optional all prefix) - "Retrieve top-level bindings from KEYMAP. -If ALL is non-nil, get all bindings, not just the top-level -ones. PREFIX is for internal use and should not be used." - (let (bindings) - (map-keymap - (lambda (ev def) - (let* ((key (append prefix (list ev))) - (key-desc (key-description key))) - (cond ((or (string-match-p - which-key--ignore-non-evil-keys-regexp key-desc) - (eq ev 'menu-bar))) - ;; extract evil keys corresponding to current state - ((and (keymapp def) - (boundp 'evil-state) - (bound-and-true-p evil-local-mode) - (string-match-p (format "<%s-state>$" evil-state) key-desc)) - (setq bindings - ;; this function keeps the latter of the two duplicates - ;; which will be the evil binding - (cl-remove-duplicates - (append bindings - (which-key--get-keymap-bindings def all prefix)) - :test (lambda (a b) (string= (car a) (car b)))))) - ((and (keymapp def) - (string-match-p which-key--evil-keys-regexp key-desc))) - ((and (keymapp def) - (or all - ;; event 27 is escape, so this will pick up meta - ;; bindings and hopefully not too much more - (and (numberp ev) (= ev 27)))) - (setq bindings - (append bindings - (which-key--get-keymap-bindings def t key)))) - (t - (when def - (cl-pushnew - (cons key-desc - (cond - ((keymapp def) "Prefix Command") - ((symbolp def) (copy-sequence (symbol-name def))) - ((eq 'lambda (car-safe def)) "lambda") - ((eq 'menu-item (car-safe def)) "menu-item") - ((stringp def) def) - ((vectorp def) (key-description def)) - ((consp def) (car def)) - (t "unknown"))) - 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. @@ -1849,78 +1798,74 @@ Requires `which-key-compute-remaps' to be non-nil" (if (and which-key-compute-remaps (setq remap (command-remapping (intern binding)))) (copy-sequence (symbol-name remap)) - binding))) + (copy-sequence (symbol-name binding))))) + +(defun which-key--get-keymap-bindings-1 + "Helper function for `which-key--get-keymap-bindings'" + (keymap start &optional prefix all ignore-commands) + (let ((bindings start) + (prefix-map (if prefix (lookup-key keymap prefix) keymap))) + (when (keymapp prefix-map) + (map-keymap + (lambda (ev def) + (let* ((key (append prefix (list ev))) + (key-desc (key-description key))) + (cond + ((assoc key-desc bindings)) + ((and (listp ignore-commands) (symbolp def) (memq def ignore-commands))) + ((or (string-match-p + which-key--ignore-non-evil-keys-regexp key-desc) + (eq ev 'menu-bar))) + ((and (keymapp def) + (string-match-p which-key--evil-keys-regexp key-desc))) + ((and (keymapp def) + (or all + ;; event 27 is escape, so this will pick up meta + ;; bindings and hopefully not too much more + (and (numberp ev) (= ev 27)))) + (setq bindings + (which-key--get-keymap-bindings-1 + keymap bindings key all ignore-commands))) + (def + (push + (cons key-desc + (cond + ((keymapp def) "+prefix") + ((symbolp def) (which-key--compute-binding def)) + ((eq 'lambda (car-safe def)) "lambda") + ((eq 'menu-item (car-safe def)) + (keymap--menu-item-binding def)) + ((stringp def) def) + ((vectorp def) (key-description def)) + ((consp def) (car def)) + (t "unknown"))) + bindings))))) + prefix-map)) + bindings)) + +(defun which-key--get-keymap-bindings (keymap &optional prefix start all evil) + "Retrieve top-level bindings from KEYMAP. +PREFIX limits bindings to those starting with this key +sequence. START is a list of existing bindings to add to. If ALL +is non-nil, recursively retrieve all bindings below PREFIX. If +EVIL is non-nil, extract active evil bidings." + (let ((bindings start) + (ignore '(self-insert-command ignore ignore-event company-ignore)) + (evil-map + (when (and evil (bound-and-true-p evil-local-mode)) + (lookup-key keymap (kbd (format "<%s-state>" evil-state)))))) + (when (keymapp evil-map) + (setq bindings (which-key--get-keymap-bindings-1 + evil-map bindings prefix all ignore))) + (which-key--get-keymap-bindings-1 keymap bindings prefix all ignore))) (defun which-key--get-current-bindings (&optional prefix) "Generate a list of current active bindings." - (let ((key-str-qt (regexp-quote (key-description prefix))) - (buffer (current-buffer)) - (ignore-bindings '("self-insert-command" "ignore" - "ignore-event" "company-ignore")) - (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 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)) 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 which-key--ignore-keys-regexp key)) - ((and 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 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))))) + (let (bindings) + (dolist (map (current-active-maps t) bindings) + (when (cdr map) + (setq bindings + (which-key--get-keymap-bindings map prefix bindings)))))) (defun which-key--get-bindings (&optional prefix keymap filter recursive) "Collect key bindings. commit 1f9c37d50f08995c8671822591c8babb893ccc6f Merge: 12f743c6955 0f6bda622e1 Author: Justin Burkett Date: Sat Jun 19 18:22:42 2021 -0400 Merge pull request #305 from tarsiiformes/first-line Improve first doc-string line in trivial cases commit 0f6bda622e19d8b7f3d39acddbff5263c69a51de Author: Jonas Bernoulli Date: Thu Jun 17 01:24:17 2021 +0200 Improve first doc-string line in trivial cases The first line of a doc-string should form a complete sentence. Many doc-strings in this package do not follow that convention but fixing them all would be difficult and is beyond the scope of this commit. However, in a few cases the fix is trivial and this commit tackles those instances. diff --git a/which-key.el b/which-key.el index 9b4005a8d78..6d69482d41d 100644 --- a/which-key.el +++ b/which-key.el @@ -56,8 +56,8 @@ :prefix "which-key-") (defcustom which-key-idle-delay 1.0 - "Delay (in seconds) for which-key buffer to popup. This - variable should be set before activating `which-key-mode'. + "Delay (in seconds) for which-key buffer to popup. +This variable should be set before activating `which-key-mode'. A value of zero might lead to issues, so a non-zero value is recommended @@ -276,14 +276,13 @@ and nil. Nil turns the feature off." (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." + "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." + "The maximum number of columns to display in the which-key buffer. +nil means don't impose a maximum." :group 'which-key :type '(choice integer (const :tag "Unbounded" nil))) @@ -500,10 +499,10 @@ The delay time is effectively added to the normal :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'." + "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)) @@ -739,9 +738,10 @@ update.") ;;;; 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." + "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) @@ -772,9 +772,10 @@ problems at github.") (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." + "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 @@ -888,8 +889,7 @@ if there is space and the bottom otherwise." ;;;###autoload (defun which-key-setup-side-window-bottom () - "Apply suggested settings for side-window that opens on -bottom." + "Apply suggested settings for side-window that opens on bottom." (interactive) (which-key--setup-echo-keystrokes) (setq which-key-popup-type 'side-window @@ -1156,8 +1156,7 @@ total height." (custom (funcall which-key-custom-hide-popup-function)))) (defun which-key--hide-popup-on-frame-size-change (&optional _) - "Hide which-key popup if the frame is resized (to trigger a new -popup)." + "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))) @@ -2249,8 +2248,9 @@ and a page count." (_ (cons page nil))))) (defun which-key--show-page (&optional n) - "Show current page. N changes the current page to the Nth page -relative to the current one." + "Show current page. +N changes the current page to the Nth page relative to the +current one." (which-key--init-buffer) ;; in case it was killed (let ((prefix-keys (which-key--current-key-string)) golden-ratio-mode) @@ -2550,8 +2550,8 @@ Only if no bindings fit fallback to LOC2." ;;;###autoload (defun which-key-show-keymap (keymap &optional no-paging) - "Show the top-level bindings in KEYMAP using which-key. KEYMAP -is selected interactively from all available keymaps. + "Show the top-level bindings in KEYMAP using which-key. +KEYMAP is selected interactively from all available keymaps. If NO-PAGING is non-nil, which-key will not intercept subsequent keypresses for the paging functionality." @@ -2562,8 +2562,8 @@ keypresses for the paging functionality." ;;;###autoload (defun which-key-show-full-keymap (keymap) - "Show all bindings in KEYMAP using which-key. KEYMAP is -selected interactively from all available keymaps." + "Show all bindings in KEYMAP using which-key. +KEYMAP is selected interactively from all available keymaps." (interactive (list (which-key--read-keymap))) (which-key--show-keymap (symbol-name keymap) (symbol-value keymap) @@ -2571,8 +2571,9 @@ selected interactively from all available keymaps." ;;;###autoload (defun which-key-show-minor-mode-keymap (&optional all) - "Show the top-level bindings in KEYMAP using which-key. KEYMAP -is selected interactively by mode in `minor-mode-map-alist'." + "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 @@ -2590,8 +2591,9 @@ is selected interactively by mode in `minor-mode-map-alist'." all))) ;;;###autoload (defun which-key-show-full-minor-mode-keymap () - "Show all bindings in KEYMAP using which-key. KEYMAP -is selected interactively by mode in `minor-mode-map-alist'." + "Show all bindings in KEYMAP using which-key. +KEYMAP is selected interactively by mode in +`minor-mode-map-alist'." (interactive) (which-key-show-minor-mode-keymap t)) commit 12f743c6955c89352f8d49d292895bd45e82d26f Author: Jonas Bernoulli Date: Tue Jun 15 19:19:44 2021 +0200 Fix whitespace diff --git a/which-key.el b/which-key.el index 89ab2aecb09..9b4005a8d78 100644 --- a/which-key.el +++ b/which-key.el @@ -997,7 +997,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (title-mode-alist (or (cdr-safe (assq mode which-key--prefix-title-alist)) (list)))) (while key-sequence - ;; normalize key sequences before adding + ;; normalize key sequences before adding (let ((key-seq (key-description (kbd key-sequence))) (replace (or (and (functionp replacement) replacement) (car-safe replacement) @@ -1646,7 +1646,7 @@ If KEY contains any \"special keys\" defined in (let ((beg (match-beginning 0)) (end (match-end 0))) (concat (substring key-w-face 0 beg) (which-key--propertize (substring key-w-face beg (1+ beg)) - 'face 'which-key-special-key-face) + 'face 'which-key-special-key-face) (substring key-w-face end (which-key--string-width key-w-face)))) key-w-face)))) @@ -2711,7 +2711,7 @@ Finally, show the buffer." (bound-and-true-p god-local-mode) (eq this-command 'god-mode-self-insert)) (setq this-command-keys (when which-key--god-mode-key-string - (kbd which-key--god-mode-key-string)))) + (kbd which-key--god-mode-key-string)))) this-command-keys)) (defun which-key--update () commit fc29864395fdaf688e2ef5111831663bad89a020 Author: Justin Burkett Date: Mon May 31 22:52:43 2021 -0400 Fix whitespace diff --git a/which-key.el b/which-key.el index d66cec5d261..89ab2aecb09 100644 --- a/which-key.el +++ b/which-key.el @@ -1176,9 +1176,9 @@ popup)." (defun which-key--popup-showing-p () (and (bufferp which-key--buffer) (or (window-live-p (get-buffer-window which-key--buffer)) - (let ((window (get-buffer-window which-key--buffer t))) - (and (window-live-p window) - (frame-visible-p (window-frame window))))))) + (let ((window (get-buffer-window which-key--buffer t))) + (and (window-live-p window) + (frame-visible-p (window-frame window))))))) (defun which-key--show-popup (act-popup-dim) "Show the which-key buffer. @@ -1186,7 +1186,7 @@ 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)) + (> (cdr act-popup-dim) 0)) (cl-case which-key-popup-type ;; Not called for minibuffer ;; (minibuffer (which-key--show-buffer-minibuffer act-popup-dim)) @@ -2779,7 +2779,7 @@ Finally, show the buffer." (setq which-key--secondary-timer-active secondary) (setq which-key--timer (run-with-idle-timer (or delay which-key-idle-delay) - t #'which-key--update))) + t #'which-key--update))) (defun which-key--stop-timer () "Deactivate idle timer for `which-key--update'." commit 7e854d02037c8ec84ac26bb77b98f670d8d3eb2e Author: Justin Burkett Date: Mon May 31 22:48:53 2021 -0400 Fix recent commit diff --git a/which-key.el b/which-key.el index 2f89f400ae5..d66cec5d261 100644 --- a/which-key.el +++ b/which-key.el @@ -1824,9 +1824,6 @@ ones. PREFIX is for internal use and should not be used." (setq bindings (append bindings (which-key--get-keymap-bindings def t key)))) - ((and def (consp def)) - (cl-pushnew (cons key-desc (car def)) - bindings :test (lambda (a b) (string= (car a) (car b))))) (t (when def (cl-pushnew @@ -1838,6 +1835,7 @@ ones. PREFIX is for internal use and should not be used." ((eq 'menu-item (car-safe def)) "menu-item") ((stringp def) def) ((vectorp def) (key-description def)) + ((consp def) (car def)) (t "unknown"))) bindings :test (lambda (a b) (string= (car a) (car b))))))))) keymap) commit 81d93952afe0bc36d95fd166de62529b656ab49f Author: Justin Burkett Date: Mon May 31 22:34:08 2021 -0400 Fix README links diff --git a/README.org b/README.org index 0f67f20262b..3064466a558 100644 --- a/README.org +++ b/README.org @@ -445,7 +445,7 @@ Note =C-h= is by default equivalent to =?= in this context. Note also that using =C-h= will not work with the =C-h= prefix, unless you - make further adjustments. See Issues #93 and #175, for example. + make further adjustments. See Issues [[https://github.com/justbur/emacs-which-key/issues/93][#93]] and [[https://github.com/justbur/emacs-which-key/issues/175][#175]] for example. **** Method 2: Bind your own keys commit ef1fc43fcb6dce6060d8d362f921dafe78fc3e26 Author: Justin Burkett Date: Mon May 31 22:30:32 2021 -0400 Reference issues #93 and #175 in README Fixes #291 diff --git a/README.org b/README.org index c417b04873e..0f67f20262b 100644 --- a/README.org +++ b/README.org @@ -444,6 +444,9 @@ Note =C-h= is by default equivalent to =?= in this context. + Note also that using =C-h= will not work with the =C-h= prefix, unless you + make further adjustments. See Issues #93 and #175, for example. + **** Method 2: Bind your own keys Essentially, all you need to do for a prefix like =C-x= is the following commit fa1b4c9b382cd719ba8122724b87d6942a6be886 Merge: 7927209c1be f6ce67d7053 Author: Justin Burkett Date: Mon May 31 22:21:44 2021 -0400 Merge pull request #303 from tarsiiformes/posframe Support packages that use another frame to display bindings commit f6ce67d7053d00e11e0eda653e2f39d7955fb3b4 Author: Jonas Bernoulli Date: Sun May 30 20:39:55 2021 +0200 Get which-key--buffer's window from any frame Previously we assumed the buffer was being displayed in a window of the current frame, which isn't the case if e.g. a child frame is being used. We also cannot assume that the third-party code that sets up such a child frame also deletes it. `which-key-posframe' for example merely hides it. diff --git a/which-key.el b/which-key.el index 3f5f8097cd1..74accfa3383 100644 --- a/which-key.el +++ b/which-key.el @@ -1175,7 +1175,10 @@ popup)." (defun which-key--popup-showing-p () (and (bufferp which-key--buffer) - (window-live-p (get-buffer-window which-key--buffer)))) + (or (window-live-p (get-buffer-window which-key--buffer)) + (let ((window (get-buffer-window which-key--buffer t))) + (and (window-live-p window) + (frame-visible-p (window-frame window))))))) (defun which-key--show-popup (act-popup-dim) "Show the which-key buffer. commit 016b9bbf869767d0a6a32b2644444dd2d85e9fc1 Author: Jonas Bernoulli Date: Sun May 30 20:18:50 2021 +0200 Cosmetics diff --git a/which-key.el b/which-key.el index b576a5b3786..3f5f8097cd1 100644 --- a/which-key.el +++ b/which-key.el @@ -724,8 +724,8 @@ update.") (which-key--pages-num-pages which-key--pages-obj))) (defsubst which-key--current-prefix () - (when which-key--pages-obj - (which-key--pages-prefix which-key--pages-obj))) + (and which-key--pages-obj + (which-key--pages-prefix which-key--pages-obj))) (defmacro which-key--debug-message (&rest msg) `(when which-key--debug-buffer-name @@ -1182,7 +1182,8 @@ popup)." 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)) + (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)) @@ -2449,9 +2450,9 @@ prefix) if `which-key-use-C-h-commands' is non nil." (interactive) (cond ((and (not (which-key--popup-showing-p)) which-key-show-early-on-C-h) - (let* ((current-prefix - (butlast - (listify-key-sequence (which-key--this-command-keys))))) + (let ((current-prefix + (butlast + (listify-key-sequence (which-key--this-command-keys))))) (which-key-reload-key-sequence current-prefix) (if which-key-idle-secondary-delay (which-key--start-timer which-key-idle-secondary-delay t) @@ -2773,10 +2774,8 @@ Finally, show the buffer." (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))) + (run-with-idle-timer (or delay which-key-idle-delay) + t #'which-key--update))) (defun which-key--stop-timer () "Deactivate idle timer for `which-key--update'." commit 1f5e53285282416be34846698fdfafc29dac034d Author: Jonas Bernoulli Date: Sun May 30 20:17:49 2021 +0200 Avoid code-duplication in which-key--hide-popup diff --git a/which-key.el b/which-key.el index 3514226f936..b576a5b3786 100644 --- a/which-key.el +++ b/which-key.el @@ -1143,17 +1143,14 @@ total height." (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))))) + (which-key--hide-popup-ignore-command))) (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 + ;; 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)))) commit aa91a7cd8347dca8978e9897b41063859e606892 Author: Jonas Bernoulli Date: Sun May 30 20:16:53 2021 +0200 Fix nesting-level of "God-mode" section diff --git a/which-key.el b/which-key.el index 8b4c60fdee8..3514226f936 100644 --- a/which-key.el +++ b/which-key.el @@ -753,7 +753,7 @@ valid keys missing and it might be showing some invalid keys." :group 'which-key :type 'boolean) -;;;;; God-mode +;;;; God-mode (defvar which-key--god-mode-support-enabled nil "Support god-mode if non-nil. This is experimental, commit 7927209c1bec93920bf68cf36ddd6832317a0ae7 Author: Jiangbin Zhao Date: Sun May 23 14:07:53 2021 -0700 fix which-key--show-keymap for which-key-enable-extended-define-key With which-key-enable-extended-define-key set to 't, given the keymap and bindings below: (setq a-map (make-sparse-keymap)) (bind-keys :map a-map ("a" . ("key 1" . command-1)) ("b" . ("key b" . command-2))) The output of (which-key--get-keymap-bindings a-map) was having "unknown" as the key descriptions. This change fixes it therefore allows the following to work as expected: (which-key--show-keymap "A map" a-map) diff --git a/which-key.el b/which-key.el index 8b4c60fdee8..c5652d803bd 100644 --- a/which-key.el +++ b/which-key.el @@ -1823,6 +1823,9 @@ ones. PREFIX is for internal use and should not be used." (setq bindings (append bindings (which-key--get-keymap-bindings def t key)))) + ((and def (consp def)) + (cl-pushnew (cons key-desc (car def)) + bindings :test (lambda (a b) (string= (car a) (car b))))) (t (when def (cl-pushnew commit 5fb30301cb3b4fca5a0e1ce8ec1ef59290b79199 Author: Frank Terbeck Date: Tue Apr 6 17:18:16 2021 +0200 Unset header-line-format format in " *which-key*" buffer Similarly to mode-line-format, header-line-format just takes up space and currently also breaks window size calculations for the buffer. This sets it to nil in order to suppress its display. Signed-off-by: Frank Terbeck diff --git a/which-key.el b/which-key.el index 55767a97f69..8b4c60fdee8 100644 --- a/which-key.el +++ b/which-key.el @@ -840,6 +840,7 @@ problems at github. If DISABLE is non-nil disable support." (setq-local cursor-type nil) (setq-local cursor-in-non-selected-windows nil) (setq-local mode-line-format nil) + (setq-local header-line-format nil) (setq-local word-wrap nil) (setq-local show-trailing-whitespace nil) (run-hooks 'which-key-init-buffer-hook)))) commit c632dbf27a77c1c73ce559041b3a78ec5f78b187 Author: Celestial Nebula <41875671+CelestialNebula@users.noreply.github.com> Date: Wed Mar 24 18:21:16 2021 +0000 Update reference to obsolete variable in DOCSTRING (#285) diff --git a/which-key.el b/which-key.el index 529bcfadc75..55767a97f69 100644 --- a/which-key.el +++ b/which-key.el @@ -964,8 +964,7 @@ 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'." +replacements are added to `which-key-replacement-alist'." ;; TODO: Make interactive (while key-sequence ;; normalize key sequences before adding commit c0608e812a8d1bc7aefeacdfaeb56a7272eabf44 Author: Justin Burkett Date: Sun Jan 31 13:37:08 2021 -0500 Version 3.5.1 diff --git a/which-key.el b/which-key.el index ba3efe3e8a3..529bcfadc75 100644 --- a/which-key.el +++ b/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.5.0 +;; Version: 3.5.1 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit 428aedfce0157920814fbb2ae5d00b4aea89df88 Author: Justin Burkett Date: Wed Dec 16 12:20:14 2020 -0500 Further simplify which-key--pseudo-key diff --git a/which-key.el b/which-key.el index b2635ea6ad9..ba3efe3e8a3 100644 --- a/which-key.el +++ b/which-key.el @@ -1596,7 +1596,7 @@ which are strings. KEY is of the form produced by `key-binding'." "Replace the last key in the sequence KEY by a special symbol in order for which-key to allow looking up a description for the key." (let ((seq (listify-key-sequence key))) - (vconcat (or prefix (butlast seq)) (vector 'which-key (last seq))))) + (vconcat (or prefix (butlast seq)) [which-key] (last seq)))) (defun which-key--maybe-get-prefix-title (keys) "KEYS is a string produced by `key-description'. commit 3908719ff2cf45ef886fa484af0cf8a81e95c9aa Author: Daniel Mendler Date: Tue Dec 15 23:49:28 2020 +0100 simplify pseudo key diff --git a/which-key.el b/which-key.el index de1aa678cfe..b2635ea6ad9 100644 --- a/which-key.el +++ b/which-key.el @@ -677,12 +677,12 @@ update.") (defvar which-key--ignore-non-evil-keys-regexp (eval-when-compile (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" - "select-window" "switch-frame" "which-key-")))) + "select-window" "switch-frame" "which-key")))) (defvar which-key--ignore-keys-regexp (eval-when-compile (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" "select-window" "switch-frame" "-state" - "which-key-")))) + "which-key")))) (make-obsolete-variable 'which-key-prefix-name-alist nil "2016-10-05") (make-obsolete-variable 'which-key-prefix-title-alist nil "2016-10-05") @@ -1595,11 +1595,8 @@ which are strings. KEY is of the form produced by `key-binding'." (defun which-key--pseudo-key (key &optional prefix) "Replace the last key in the sequence KEY by a special symbol in order for which-key to allow looking up a description for the key." - (let* ((seq (listify-key-sequence key)) - (final (intern (format "which-key-%s" (key-description (last seq)))))) - (if prefix - (vconcat prefix (list final)) - (vconcat (butlast seq) (list final))))) + (let ((seq (listify-key-sequence key))) + (vconcat (or prefix (butlast seq)) (vector 'which-key (last seq))))) (defun which-key--maybe-get-prefix-title (keys) "KEYS is a string produced by `key-description'. commit ca268fd313d3fb2bd03a8b5e4bdcca675ce58ca7 Author: BlaCk_Void Date: Fri Nov 13 01:22:08 2020 +0000 REAMDE code's Number of parentheses pairs (#270) diff --git a/README.org b/README.org index d2d375d3a98..c417b04873e 100644 --- a/README.org +++ b/README.org @@ -363,10 +363,10 @@ 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)) + (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 commit c011b268196b8356c70f668506a1133086bc9477 Author: Justin Burkett Date: Mon Oct 19 11:15:35 2020 -0400 Add tests for keymap-based-bindings diff --git a/which-key-tests.el b/which-key-tests.el index f9fac65c73b..1611d51cc04 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -27,7 +27,24 @@ (require 'which-key) (require 'ert) -(ert-deftest which-key-test-prefix-declaration () +(ert-deftest which-key-test--keymap-based-bindings () + (let ((map (make-sparse-keymap)) + (emacs-lisp-mode-map (copy-keymap emacs-lisp-mode-map))) + (emacs-lisp-mode) + (define-key map "x" 'ignore) + (define-key emacs-lisp-mode-map "\C-c\C-a" 'complete) + (define-key emacs-lisp-mode-map "\C-c\C-b" map) + (which-key-add-keymap-based-replacements emacs-lisp-mode-map + "C-c C-a" '("mycomplete" . complete) + "C-c C-b" "mymap") + (should (equal + (which-key--maybe-replace '("C-c C-a" . "complete")) + '("C-c C-a" . "mycomplete"))) + (should (equal + (which-key--maybe-replace '("C-c C-b" . "")) + '("C-c C-b" . "mymap"))))) + +(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) commit 427c3f4a53fe70799b08ff49c23ddd41ab2376c6 Author: Justin Burkett Date: Sun Oct 18 15:34:53 2020 -0400 Clarify README's description of keymap-based replacement diff --git a/README.org b/README.org index 92745fff308..d2d375d3a98 100644 --- a/README.org +++ b/README.org @@ -257,47 +257,49 @@ *** 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=. + replacement methods. The first, keymap-based replacement, is preferred and + will take precedence over the others. The remaining methods are still + available, because they pre-date the first and are more flexible in what + they can accomplish. -**** Automatic ("keymap-based") replacement - A newer option is to set =which-key-enable-extended-define-key= which - advises =define-key= to allow which-key to pre-process its arguments. With - this option enabled, the statement +**** Keymap-based replacement + Using this method, which-key can display a custom string for a key + definition in some keymap. There are two ways to define a keymap-based + replacement. The first is to use + =which-key-add-keymap-based-replacements=. The statement #+BEGIN_SRC emacs-lisp - (define-key some-map "f" '("foo" . command-foo)) + (define-key some-map "f" 'long-command-name-foo) + (define-key some-map "b" some-prefix-map) + (which-key-add-keymap-based-replacements some-map + "f" '("foo" . long-command-name-foo) + ;; or + ;; "f" "foo" (see the docstring) + "b" '("bar-prefix") + ;; or + ;; "b" "bar-prefix" (see the docstring) + ) #+END_SRC - will both bind the command =command-foo= to "f" in =some-map= and tell - which-key to use the string "foo" for this command. This also works with - naming prefixes if you use =nil= for the command. The following binds "b" - to =nil= and names the binding as a prefix. + uses =define-key= to add two bindings and tells which-key to use the string + "foo" in place of "command-foo" and the string "bar-prefix" for + some-prefix-map. Note that =which-key-add-keymap-based-replacements= will + not bind a command, so =define-key= must still be used. - #+BEGIN_SRC emacs-lisp - (define-key some-map "b" '("bar-prefix")) - #+END_SRC - - If you do not want to enable the advise on =define-key=, you may also use - =which-key-add-keymap-based-replacements=. The first example can be - alternatively written as + Alternatively, you may set =which-key-enable-extended-define-key= to =t= + before loading which-key and accomplish the same effect using only + =define-key= as follows. #+BEGIN_SRC emacs-lisp - (define-key some-map "f" 'command-foo) - (define-key some-map "b" some-prefix-map) - (which-key-add-keymap-based-replacements some-map - "f" '("foo" . long-name-for-command-foo) - ;; or - ;; "f" "foo" - "b" '("bar-prefix") - ;; or - ;; "b" "bar-prefix" - ) + (define-key some-map "f" '("foo" . command-foo)) + (define-key some-map "b" '("bar-prefix")) #+END_SRC - Note that =which-key-add-keymap-based-replacements= will not bind a - command, so =define-key= must still be used. + The option =which-key-enable-extended-define-key= advises =define-key= to + allow which-key to use the =(NAME . COMMAND)= notation to simultaneously + define a command and give that command a name using =define-key=. Since + many key-binding utilities use =define-key= internally, this functionality + should be available with your favorite method of defining keys as well. There are other methods of telling which-key to replace command names, which are described next. The keymap-based replacements should be the most @@ -306,7 +308,7 @@ replace text. They can be used simultaneously, but which-key will give precedence to the keymap-based replacement when it exists. -**** "Key-Based" replacement +**** Key-Based replacement Using this method, the description of a key is replaced using a string that you provide. Here's an example commit ae59b7edb0d82aa0251803fdfbde6b865083c8b8 Author: Justin Burkett Date: Tue Sep 8 19:01:44 2020 -0400 Version 3.5.0 diff --git a/which-key.el b/which-key.el index 1dbdd08400b..de1aa678cfe 100644 --- a/which-key.el +++ b/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.3.2 +;; Version: 3.5.0 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit 5b37abcbe74ae5012802eacaba3235e310905949 Author: Justin Burkett Date: Tue Sep 8 18:59:30 2020 -0400 Fix which-key--next-page-hint prefix-keys might be a vector. Fixes #265 diff --git a/which-key.el b/which-key.el index a25337f3d9a..1dbdd08400b 100644 --- a/which-key.el +++ b/which-key.el @@ -2126,8 +2126,9 @@ max-lines max-width avl-lines avl-width (which-key--pages-height result)) (concat key " or " which-key-paging-key) key))) (when (and which-key-use-C-h-commands - (not (string-equal (char-to-string help-char) - (kbd prefix-keys)))) + (or (not (stringp (kbd prefix-keys))) + (not (string-equal (char-to-string help-char) + (kbd prefix-keys))))) (which-key--propertize (format "[%s paging/help]" key) 'face 'which-key-note-face)))) commit a70fc16adcf604f2cb8061d77813354da018c541 Author: Justin Burkett Date: Tue Sep 8 14:18:21 2020 -0400 Hide paging hint when prefix is help-char We can't do paging in this case. diff --git a/which-key.el b/which-key.el index c08cfd8af64..a25337f3d9a 100644 --- a/which-key.el +++ b/which-key.el @@ -2125,7 +2125,9 @@ max-lines max-width avl-lines avl-width (which-key--pages-height result)) (key (if paging-key-bound (concat key " or " which-key-paging-key) key))) - (when which-key-use-C-h-commands + (when (and which-key-use-C-h-commands + (not (string-equal (char-to-string help-char) + (kbd prefix-keys)))) (which-key--propertize (format "[%s paging/help]" key) 'face 'which-key-note-face)))) commit d794c4a0afdf9b9f0a9df86a9797789c703591ee Author: Justin Burkett Date: Fri Sep 4 16:06:48 2020 -0400 Improve keymap-based-replacement description in README Ref #263 diff --git a/README.org b/README.org index 301849e37ff..92745fff308 100644 --- a/README.org +++ b/README.org @@ -263,27 +263,29 @@ **** Automatic ("keymap-based") replacement A newer option is to set =which-key-enable-extended-define-key= which - advises =define-key= to allow which-key to pre-process its arguments. The - statement + advises =define-key= to allow which-key to pre-process its arguments. With + this option enabled, the statement #+BEGIN_SRC emacs-lisp - (define-key some-map "f" '("foo" . long-name-for-command-foo)) + (define-key some-map "f" '("foo" . command-foo)) #+END_SRC - is valid in Emacs. Setting this variable makes which-key automatically - replace the corresponding command name with the text in the string. A nice - example is in naming prefixes. The following binds "b" to =nil= and names - the binding as a prefix. + will both bind the command =command-foo= to "f" in =some-map= and tell + which-key to use the string "foo" for this command. This also works with + naming prefixes if you use =nil= for the command. The following binds "b" + to =nil= and names the binding as a prefix. #+BEGIN_SRC emacs-lisp (define-key some-map "b" '("bar-prefix")) #+END_SRC If you do not want to enable the advise on =define-key=, you may also use - =which-key-add-keymap-based-replacements=. The above examples can be + =which-key-add-keymap-based-replacements=. The first example can be alternatively written as #+BEGIN_SRC emacs-lisp + (define-key some-map "f" 'command-foo) + (define-key some-map "b" some-prefix-map) (which-key-add-keymap-based-replacements some-map "f" '("foo" . long-name-for-command-foo) ;; or @@ -294,10 +296,15 @@ ) #+END_SRC - Note that while the alternative methods below use - =which-key-replacement-alist=, the "keymap-based" replacements store - replacements in the keymaps themselves, so should avoid performance issues - when =which-key-replacement-alist= becomes very large. + Note that =which-key-add-keymap-based-replacements= will not bind a + command, so =define-key= must still be used. + + There are other methods of telling which-key to replace command names, + which are described next. The keymap-based replacements should be the most + performant since they use built-in functionality of emacs. However, the + alternatives can be more flexible in telling which-key how and when to + replace text. They can be used simultaneously, but which-key will give + precedence to the keymap-based replacement when it exists. **** "Key-Based" replacement Using this method, the description of a key is replaced using a string that commit 2b10b8e77dc53f4d88191ac6e6675ecf1f1ccc63 Author: Justin Burkett Date: Tue Sep 1 21:35:43 2020 -0400 Remove use of focus-{in,out}-hook Fix #259 #260 #262 diff --git a/which-key.el b/which-key.el index 6eb8e359959..c08cfd8af64 100644 --- a/which-key.el +++ b/which-key.el @@ -815,8 +815,6 @@ problems at github. If DISABLE is non-nil disable support." (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-size-change-functions 'which-key--hide-popup-on-frame-size-change) (which-key--start-timer)) @@ -826,8 +824,6 @@ problems at github. If DISABLE is non-nil disable support." (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-size-change-functions 'which-key--hide-popup-on-frame-size-change) (which-key--stop-timer))) commit e5543269fc2295e196a7824715b2e88b1b70345d Author: Justin Burkett Date: Fri Aug 28 10:27:24 2020 -0400 Remove testing badge from README Github integrates the results into the interface already, and it doesn't seem to work. diff --git a/README.org b/README.org index c335e457b30..301849e37ff 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,6 @@ * 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]] [[build][https://github.com/justbur/emacs-which-key/workflows/which-key-test/badge.svg]] + [[http://stable.melpa.org/#/which-key][file:http://stable.melpa.org/packages/which-key-badge.svg]] ** Recent Changes commit e048b2ae6ba890be0100f20bacaf291e83359e26 Author: Justin Burkett Date: Fri Aug 28 10:24:31 2020 -0400 Stop testing against v24.5 It's old enough now diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index c4eaf232756..3ae62889444 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -13,7 +13,6 @@ jobs: strategy: matrix: emacs_version: - - 24.5 - 25.1 - 25.2 - 25.3 commit ebb4e92b3ccab1d813346e24dccf9692850754db Author: Justin Burkett Date: Fri Aug 28 10:17:40 2020 -0400 Add which-key-add-keymap-based-replacements This is an alternative to advising define-key using which-key-enable-extended-define-key, but functions the same beneath the surface. Ref #226 #261 diff --git a/README.org b/README.org index cb31655237b..c335e457b30 100644 --- a/README.org +++ b/README.org @@ -4,6 +4,11 @@ ** Recent Changes +*** 2020-08-28: Added =which-key-add-keymap-based-replacements= + This function provides an alternative interface allowing replacements to be + stored directly in keymaps, allowing one to avoid using + =which-key-replacement-alist=, which may cause performance issues when it + gets very big. *** 2019-08-01: Added =which-key-show-early-on-C-h= Allows one to trigger =which-key= on demand, rather than automatically. See the docstring and [[#manual-activation][Manual Activation]]. @@ -29,6 +34,7 @@ ** Table of Contents :TOC_3: - [[#which-key][which-key]] - [[#recent-changes][Recent Changes]] + - [[#2020-08-28-added-which-key-add-keymap-based-replacements][2020-08-28: Added =which-key-add-keymap-based-replacements=]] - [[#2019-08-01-added-which-key-show-early-on-c-h][2019-08-01: Added =which-key-show-early-on-C-h=]] - [[#2017-12-13-added-which-key-enable-extended-define-key][2017-12-13: Added =which-key-enable-extended-define-key=]] - [[#2017-11-13-added-which-key-show-major-mode][2017-11-13: Added =which-key-show-major-mode=]] @@ -255,7 +261,7 @@ 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=. -**** Automatic +**** Automatic ("keymap-based") replacement A newer option is to set =which-key-enable-extended-define-key= which advises =define-key= to allow which-key to pre-process its arguments. The statement @@ -273,6 +279,26 @@ (define-key some-map "b" '("bar-prefix")) #+END_SRC + If you do not want to enable the advise on =define-key=, you may also use + =which-key-add-keymap-based-replacements=. The above examples can be + alternatively written as + + #+BEGIN_SRC emacs-lisp + (which-key-add-keymap-based-replacements some-map + "f" '("foo" . long-name-for-command-foo) + ;; or + ;; "f" "foo" + "b" '("bar-prefix") + ;; or + ;; "b" "bar-prefix" + ) + #+END_SRC + + Note that while the alternative methods below use + =which-key-replacement-alist=, the "keymap-based" replacements store + replacements in the keymaps themselves, so should avoid performance issues + when =which-key-replacement-alist= becomes very large. + **** "Key-Based" replacement Using this method, the description of a key is replaced using a string that you provide. Here's an example diff --git a/which-key.el b/which-key.el index 766c8f1f86a..6eb8e359959 100644 --- a/which-key.el +++ b/which-key.el @@ -912,6 +912,41 @@ but more functional." ;;; Helper functions to modify replacement lists. +;;;###autoload +(defun which-key-add-keymap-based-replacements (keymap key replacement &rest more) + "Replace the description of KEY using REPLACEMENT in KEYMAP. +KEY should take a format suitable for use in +`kbd'. REPLACEMENT is the string to use to describe the +command associated with KEY in the KEYMAP. You may also use a +cons cell of the form \(STRING . COMMAND\) for each REPLACEMENT, +where STRING is the replacement string and COMMAND is a symbol +corresponding to the intended command to be replaced. In the +latter case, which-key will verify the intended command before +performing the replacement. COMMAND should be nil if the binding +corresponds to a key prefix. For example, + +\(which-key-add-keymap-based-replacements global-map + \"C-x w\" \"Save as\"\) + +and + +\(which-key-add-keymap-based-replacements global-map + \"C-x w\" '\(\"Save as\" . write-file\)\) + +both have the same effect for the \"C-x C-w\" key binding, but +the latter causes which-key to verify that the key sequence is +actually bound to write-file before performing the replacement." + (while key + (let ((string (if (stringp replacement) + replacement + (car-safe replacement))) + (command (cdr-safe replacement))) + (define-key keymap (which-key--pseudo-key (kbd key)) + `(which-key ,(cons string command)))) + (setq key (pop more) + replacement (pop more)))) +(put 'which-key-add-keymap-based-replacements 'lisp-indent-function 'defun) + ;;;###autoload (defun which-key-add-key-based-replacements (key-sequence replacement &rest more) @@ -1462,19 +1497,18 @@ local bindings coming first. Within these categories order using (cdr key-binding))))))) (defun which-key--get-pseudo-binding (key-binding &optional prefix) - (let* ((pseudo-binding - (key-binding (which-key--pseudo-key (kbd (car key-binding)) prefix))) - (pseudo-binding (when pseudo-binding (cadr pseudo-binding))) - (pseudo-desc (when pseudo-binding (car pseudo-binding))) - (pseudo-def (when pseudo-binding (cdr pseudo-binding))) - (real-def (key-binding (kbd (car key-binding)))) - ;; treat keymaps as if they're nil bindings. This creates the - ;; possibility that we rename the wrong binding but this seems - ;; unlikely. - (real-def (unless (keymapp real-def) real-def))) - (when (and pseudo-binding - (eq pseudo-def real-def)) - (cons (car key-binding) pseudo-desc)))) + (let* ((key (kbd (car key-binding))) + (pseudo-binding (key-binding (which-key--pseudo-key key prefix)))) + (when pseudo-binding + (let* ((command-replacement (cadr pseudo-binding)) + (pseudo-desc (car command-replacement)) + (pseudo-def (cdr command-replacement))) + (when (and (stringp pseudo-desc) + (or (null pseudo-def) + ;; don't verify keymaps + (keymapp pseudo-def) + (eq pseudo-def (key-binding key)))) + (cons (car key-binding) pseudo-desc)))))) (defsubst which-key--replace-in-binding (key-binding repl) (cond ((or (not (consp repl)) (null (cdr repl))) commit e48e190a75a0c176e1deac218b891e77792d6921 Author: Rudi Grinberg Date: Tue Aug 18 07:58:31 2020 +0800 Fix #257 (#258) * Add test for #257 Signed-off-by: Rudi Grinberg * Fix #257 Explicitly distinguish between replacing with `nil` and not replacing at all. I'm also simplifying the code by making all the branches more explicit. This is a little longer, but makes all the clauses obvious. Signed-off-by: Rudi Grinberg diff --git a/which-key-tests.el b/which-key-tests.el index ae015bec6ef..f9fac65c73b 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -148,6 +148,13 @@ ("e e e" . "eee") ("f" . "{ - C-f")))))) +(ert-deftest which-key-test--nil-replacement () + (let ((which-key-replacement-alist + '(((nil . "winum-select-window-[1-9]") . t)))) + (should (equal + (which-key--maybe-replace '("C-c C-c" . "winum-select-window-1")) + '())))) + (ert-deftest which-key-test--key-sorting () (let ((keys '(("a" . "z") ("A" . "Z") diff --git a/which-key.el b/which-key.el index 143540f2ee4..766c8f1f86a 100644 --- a/which-key.el +++ b/which-key.el @@ -1497,33 +1497,40 @@ local bindings coming first. Within these categories order using (defun which-key--replace-in-repl-list-once (key-binding repls) (cl-dolist (repl repls) (when (which-key--match-replacement key-binding repl) - (cl-return (which-key--replace-in-binding key-binding repl))))) + (cl-return `(replaced . ,(which-key--replace-in-binding key-binding repl)))))) (defun which-key--replace-in-repl-list-many (key-binding repls) - (dolist (repl repls key-binding) - (when (which-key--match-replacement key-binding repl) - (setq key-binding (which-key--replace-in-binding key-binding repl))))) + (let (found) + (dolist (repl repls) + (when (which-key--match-replacement key-binding repl) + (setq found 't) + (setq key-binding (which-key--replace-in-binding key-binding repl)))) + (when found `(replaced . ,key-binding)))) (defun which-key--maybe-replace (key-binding &optional prefix) "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* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix)) - replaced-key-binding) + (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix))) (if pseudo-binding pseudo-binding (let* ((replacer (if which-key-allow-multiple-replacements #'which-key--replace-in-repl-list-many #'which-key--replace-in-repl-list-once))) - (setq replaced-key-binding - (apply replacer - (list key-binding - (cdr-safe (assq major-mode which-key-replacement-alist))))) - ;; terminate early if we're only looking for one replacement and we found it - (if (and replaced-key-binding (not which-key-allow-multiple-replacements)) - replaced-key-binding - (setq key-binding (or replaced-key-binding key-binding)) - (or (apply replacer (list key-binding which-key-replacement-alist)) key-binding)))))) + (pcase + (apply replacer + (list key-binding + (cdr-safe (assq major-mode which-key-replacement-alist)))) + (`(replaced . ,repl) + (if which-key-allow-multiple-replacements + (pcase (apply replacer (list repl which-key-replacement-alist)) + (`(replaced . ,repl) repl) + ('() repl)) + repl)) + ('() + (pcase (apply replacer (list key-binding which-key-replacement-alist)) + (`(replaced . ,repl) repl) + ('() key-binding)))))))) (defsubst which-key--current-key-list (&optional key-str) (append (listify-key-sequence (which-key--current-prefix)) commit 3642c11d5ef9be3c6fb9edb8fd5ec3c370abd889 Author: Rudi Grinberg Date: Thu Jul 16 18:14:09 2020 -0700 Speed up which-key--maybe-replace The first optimization is avoiding the intermediate list created by append. Instead we just iterate over the two lists in turn The second opimitization occurs where which-key-allow-multiple-replacements is nil, in which case we can stop the iteration once we've found a replacement Signed-off-by: Rudi Grinberg diff --git a/which-key.el b/which-key.el index 475772f0e3c..143540f2ee4 100644 --- a/which-key.el +++ b/which-key.el @@ -1476,39 +1476,54 @@ local bindings coming first. Within these categories order using (eq pseudo-def real-def)) (cons (car key-binding) pseudo-desc)))) +(defsubst which-key--replace-in-binding (key-binding repl) + (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))))))) + +(defun which-key--replace-in-repl-list-once (key-binding repls) + (cl-dolist (repl repls) + (when (which-key--match-replacement key-binding repl) + (cl-return (which-key--replace-in-binding key-binding repl))))) + +(defun which-key--replace-in-repl-list-many (key-binding repls) + (dolist (repl repls key-binding) + (when (which-key--match-replacement key-binding repl) + (setq key-binding (which-key--replace-in-binding key-binding repl))))) + (defun which-key--maybe-replace (key-binding &optional prefix) "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* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix)) - one-match) + replaced-key-binding) (if pseudo-binding pseudo-binding - (let* ((all-repls - (append (cdr-safe (assq major-mode which-key-replacement-alist)) - which-key-replacement-alist))) - (dolist (repl all-repls key-binding) - (when (and (or which-key-allow-multiple-replacements - (not one-match)) - (which-key--match-replacement key-binding repl)) - (setq one-match t) - (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))))))))))))) + (let* ((replacer (if which-key-allow-multiple-replacements + #'which-key--replace-in-repl-list-many + #'which-key--replace-in-repl-list-once))) + (setq replaced-key-binding + (apply replacer + (list key-binding + (cdr-safe (assq major-mode which-key-replacement-alist))))) + ;; terminate early if we're only looking for one replacement and we found it + (if (and replaced-key-binding (not which-key-allow-multiple-replacements)) + replaced-key-binding + (setq key-binding (or replaced-key-binding key-binding)) + (or (apply replacer (list key-binding which-key-replacement-alist)) key-binding)))))) (defsubst which-key--current-key-list (&optional key-str) (append (listify-key-sequence (which-key--current-prefix)) commit ce25fb260003eb965e1c104804f690d9405ec8b4 Author: Justin Burkett Date: Tue Jul 21 10:16:25 2020 -0400 Add basic PR template diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md new file mode 100644 index 00000000000..70cf8f0739a --- /dev/null +++ b/.github/pull_request_template.md @@ -0,0 +1,4 @@ +Pull requests are welcome as long as the following apply. + +1. The issue you are fixing or feature you are adding is clearly described and/or referenced in the pull request or github issue. +2. Since which-key is on [GNU ELPA](https://elpa.gnu.org/packages/), any [legally significant](https://www.gnu.org/prep/maintain/html_node/Legally-Significant.html#Legally-Significant) changes must have their copyright assigned to the FSF ([more info](https://www.gnu.org/prep/maintain/html_node/Copyright-Papers.html)). If you have not done so and would like to assign copyright, please see the [request form](https://git.savannah.gnu.org/cgit/gnulib.git/tree/doc/Copyright/request-assign.future). This process is easy, but can be slow. commit 8f2427a69bc0388ddfb14a10eaf71e589f3b0913 Author: N V <44036031+progfolio@users.noreply.github.com> Date: Wed Jul 1 22:19:37 2020 -0400 Fix which-key--propertize-description use make-text-button return value (#249) As of: https://github.com/emacs-mirror/emacs/commit/7ac79872aed63110c0d26c1e62e1838d6101c9bd make-text-button no longer modifies a string when it is passed as the first argument. which-key--propertize-description relied on the mutation of the string argument. Using the return value of make-text-button will return the propertized string with both the new and old behavior. Fixes #248 diff --git a/which-key.el b/which-key.el index 8c88b44c177..475772f0e3c 100644 --- a/which-key.el +++ b/which-key.el @@ -1663,8 +1663,7 @@ ORIGINAL-DESCRIPTION is the description given by (max (floor (* (frame-width) 0.8)))) (if (> (length str) max) (concat (substring str 0 max) "...") - str)))))) - desc))) + str))))))))) (defun which-key--extract-key (key-str) "Pull the last key (or key range) out of KEY-STR." commit 8b49ae978cceca65967f3544c236f32964ddbed0 Author: Justin Burkett Date: Sun Feb 16 18:22:45 2020 -0500 Fix last commit diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 56b2e9e007e..c4eaf232756 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -5,7 +5,7 @@ on: branches: - master schedule: - - cron: '* * 1 * *' + - cron: '0 0 1 * *' jobs: build: commit 7bc87e0f93bd0258bf115cb02c4e8f86f57b38fc Author: Justin Burkett Date: Sun Feb 16 13:54:20 2020 -0500 Test once a month diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index eb2a91ea091..56b2e9e007e 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -4,6 +4,8 @@ on: push: branches: - master + schedule: + - cron: '* * 1 * *' jobs: build: commit 9550707d52894208894c036a0b83f958af887e3c Merge: f9d8d49d1f9 9d1de2f1273 Author: Justin Burkett Date: Sun Feb 16 13:50:34 2020 -0500 Merge remote-tracking branch 'hlissner/patch-1' commit f9d8d49d1f955202514196de23369d61a42d816c Author: Yunhao Zhao Date: Sun Feb 16 21:50:11 2020 +0800 Fix prefix argument for which-key-show-major-mode (#239) diff --git a/which-key.el b/which-key.el index e5127eefdbe..8c88b44c177 100644 --- a/which-key.el +++ b/which-key.el @@ -2317,7 +2317,7 @@ after first page." This function will also detect evil bindings made using `evil-define-key' in this map. These bindings will depend on the current evil state. " - (interactive) + (interactive "P") (let ((map-sym (intern (format "%s-map" major-mode)))) (if (and (boundp map-sym) (keymapp (symbol-value map-sym))) (which-key--show-keymap commit 7b068f3e95a0d777cbdba92aecb6c876ccddbae5 Author: Justin Burkett Date: Wed Feb 12 09:23:18 2020 -0500 Fix case sorting in alpha sort functions diff --git a/which-key-tests.el b/which-key-tests.el index 81797975184..ae015bec6ef 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -170,12 +170,12 @@ (should (equal (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha)) - '("SPC" "a" "A" "b" "B" "p" "C-a")))) + '("SPC" "A" "a" "B" "b" "p" "C-a")))) (let (which-key-sort-uppercase-first) (should (equal (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha)) - '("SPC" "A" "a" "B" "b" "p" "C-a")))) + '("SPC" "a" "A" "b" "B" "p" "C-a")))) (let ((which-key-sort-uppercase-first t)) (should (equal diff --git a/which-key.el b/which-key.el index d0a28a10589..e5127eefdbe 100644 --- a/which-key.el +++ b/which-key.el @@ -1321,11 +1321,11 @@ width) in lines and characters respectively." (cond ((and alpha (not which-key-sort-uppercase-first)) (if (string-equal da db) - (string-lessp a b) + (not (string-lessp a b)) (string-lessp da db))) ((and alpha which-key-sort-uppercase-first) (if (string-equal da db) - (not (string-lessp a b)) + (string-lessp a b) (string-lessp da db))) ((not which-key-sort-uppercase-first) (let ((aup (not (string-equal da a))) commit 9ff54fffbb20ad92361aeeae4bc5966dbe793dd0 Author: Justin Burkett Date: Tue Feb 11 21:48:57 2020 -0500 Fix short windows being resized fit-window-to-buffer defaults to a min height of 4. For some reason, the order in which fit-window-to-buffer is called in display-buffer-in-side-window seems to have changed. This makes the order not matter. diff --git a/which-key.el b/which-key.el index 312272c6b7b..d0a28a10589 100644 --- a/which-key.el +++ b/which-key.el @@ -1167,7 +1167,8 @@ is shown, or if there is no need to start the closing timer." "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)) + (let ((fit-window-to-buffer-horizontally t) + (window-min-height 1)) (apply #'fit-window-to-buffer window params))) (defun which-key--show-buffer-side-window (act-popup-dim) commit 6e4b4c5419b7b981da6300302278de167f76126b Author: Justin Burkett Date: Fri Feb 7 22:40:28 2020 -0500 Simplify last commit diff --git a/which-key.el b/which-key.el index e0b30de8895..312272c6b7b 100644 --- a/which-key.el +++ b/which-key.el @@ -1329,7 +1329,7 @@ width) in lines and characters respectively." ((not which-key-sort-uppercase-first) (let ((aup (not (string-equal da a))) (bup (not (string-equal db b)))) - (if (or (and aup bup) (and (not aup) (not bup))) + (if (eq aup bup) (string-lessp a b) bup))) (t (string-lessp a b))))) commit d5a42732a6f39bb4284f378a6996aacecf888dc0 Author: Justin Burkett Date: Fri Feb 7 22:34:41 2020 -0500 Replace use of xor Apparently this is a recent function diff --git a/which-key.el b/which-key.el index f7bab55d317..e0b30de8895 100644 --- a/which-key.el +++ b/which-key.el @@ -1329,7 +1329,7 @@ width) in lines and characters respectively." ((not which-key-sort-uppercase-first) (let ((aup (not (string-equal da a))) (bup (not (string-equal db b)))) - (if (not (xor aup bup)) + (if (or (and aup bup) (and (not aup) (not bup))) (string-lessp a b) bup))) (t (string-lessp a b))))) commit a135e6f2c83e296da3ccfebc57a71e2b45a4f7c2 Author: Justin Burkett Date: Fri Feb 7 22:32:41 2020 -0500 Change name of workflow diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 0bf32f2e8e4..eb2a91ea091 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -1,4 +1,4 @@ -name: which-key-test-workflow +name: which-key-test on: pull_request: push: diff --git a/README.org b/README.org index 40bcca7ecee..cb31655237b 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,6 @@ * 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]] [[build][https://github.com/justbur/emacs-which-key/workflows/which-key-test-workflow/badge.svg]] + [[http://stable.melpa.org/#/which-key][file:http://stable.melpa.org/packages/which-key-badge.svg]] [[build][https://github.com/justbur/emacs-which-key/workflows/which-key-test/badge.svg]] ** Recent Changes commit 90d10a8fb335a21008084ab8b4ba722347ec6c74 Author: Justin Burkett Date: Fri Feb 7 22:29:40 2020 -0500 Fix sorting of keys and add test Fixes #233 diff --git a/which-key-tests.el b/which-key-tests.el index cff7fab56e6..81797975184 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -148,5 +148,70 @@ ("e e e" . "eee") ("f" . "{ - C-f")))))) +(ert-deftest which-key-test--key-sorting () + (let ((keys '(("a" . "z") + ("A" . "Z") + ("b" . "y") + ("B" . "Y") + ("p" . "Prefix") + ("SPC" . "x") + ("C-a" . "w")))) + (let ((which-key-sort-uppercase-first t)) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order)) + '("SPC" "A" "B" "a" "b" "p" "C-a")))) + (let (which-key-sort-uppercase-first) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order)) + '("SPC" "a" "b" "p" "A" "B" "C-a")))) + (let ((which-key-sort-uppercase-first t)) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha)) + '("SPC" "a" "A" "b" "B" "p" "C-a")))) + (let (which-key-sort-uppercase-first) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha)) + '("SPC" "A" "a" "B" "b" "p" "C-a")))) + (let ((which-key-sort-uppercase-first t)) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) + 'which-key-prefix-then-key-order)) + '("SPC" "A" "B" "a" "b" "C-a" "p")))) + (let (which-key-sort-uppercase-first) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) + 'which-key-prefix-then-key-order)) + '("SPC" "a" "b" "A" "B" "C-a" "p")))) + (let ((which-key-sort-uppercase-first t)) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) + 'which-key-prefix-then-key-order-reverse)) + '("p" "SPC" "A" "B" "a" "b" "C-a")))) + (let (which-key-sort-uppercase-first) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) + 'which-key-prefix-then-key-order-reverse)) + '("p" "SPC" "a" "b" "A" "B" "C-a")))) + (let ((which-key-sort-uppercase-first t)) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) + 'which-key-description-order)) + '("p" "C-a" "SPC" "b" "B" "a" "A")))) + (let (which-key-sort-uppercase-first) + (should + (equal + (mapcar 'car (sort (copy-sequence keys) + 'which-key-description-order)) + '("p" "C-a" "SPC" "b" "B" "a" "A")))))) + (provide 'which-key-tests) ;;; which-key-tests.el ends here diff --git a/which-key.el b/which-key.el index 09f50417ab7..f7bab55d317 100644 --- a/which-key.el +++ b/which-key.el @@ -1315,14 +1315,24 @@ width) in lines and characters respectively." ;;; 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))))) + (let ((da (downcase a)) + (db (downcase b))) + (cond + ((and alpha (not which-key-sort-uppercase-first)) + (if (string-equal da db) + (string-lessp a b) + (string-lessp da db))) + ((and alpha which-key-sort-uppercase-first) + (if (string-equal da db) + (not (string-lessp a b)) + (string-lessp da db))) + ((not which-key-sort-uppercase-first) + (let ((aup (not (string-equal da a))) + (bup (not (string-equal db b)))) + (if (not (xor aup bup)) + (string-lessp a b) + bup))) + (t (string-lessp a b))))) (defun which-key--key-description< (a b &optional alpha) "Sorting function used for `which-key-key-order' and commit c4b7aaefc160478b7bbd07251a9772c75944ffe5 Author: Justin Burkett Date: Fri Feb 7 10:02:52 2020 -0500 Revive Cask file diff --git a/Cask b/Cask new file mode 100644 index 00000000000..60fa07cbdf2 --- /dev/null +++ b/Cask @@ -0,0 +1,7 @@ +(source gnu) +(source melpa) + +(package-file "which-key.el") + +(development + (depends-on "ert")) commit cf446414850d93d6bb218cd54cec6d3c0d459a00 Author: Justin Burkett Date: Thu Feb 6 21:55:41 2020 -0500 Replace travis badge with github workflow badge diff --git a/README.org b/README.org index 7b0de1c3cb7..40bcca7ecee 100644 --- a/README.org +++ b/README.org @@ -1,5 +1,6 @@ * 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]] + [[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]] [[build][https://github.com/justbur/emacs-which-key/workflows/which-key-test-workflow/badge.svg]] ** Recent Changes commit 190310d59e7be998d8a3ec7b92c2df3116b2e00c Author: Justin Burkett Date: Thu Feb 6 21:54:34 2020 -0500 Disable travis and cask diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 60d8d31e675..00000000000 --- a/.travis.yml +++ /dev/null @@ -1,24 +0,0 @@ -# language: emacs-lisp -env: - - EVM_EMACS=emacs-25.3-travis - - EVM_EMACS=emacs-26.1-travis - - EVM_EMACS=emacs-26.2-travis - - EVM_EMACS=emacs-26.3-travis - - EVM_EMACS=emacs-git-snapshot-travis - -before_install: - - git clone https://github.com/rejeep/evm.git $HOME/.evm - - export PATH="$HOME/.evm/bin:$PATH" - - export PATH="$HOME/.cask/bin:$PATH" - - evm config path /tmp - - evm install $EVM_EMACS --use --skip - - curl -fsSkL https://raw.github.com/cask/cask/master/go | python - -matrix: - fast_finish: true - allow_failures: - - env: EVM_EMACS=emacs-git-snapshot-travis - -script: - - emacs --version - - make test diff --git a/Cask b/Cask deleted file mode 100644 index d8171e342fc..00000000000 --- a/Cask +++ /dev/null @@ -1,8 +0,0 @@ -(source gnu) -(source melpa) - -(package-file "which-key.el") - -(development - (depends-on "ert")) - commit 12310164a45f3ff19c4fd21c5487b6d804cbc80a Author: Justin Burkett Date: Thu Feb 6 21:50:04 2020 -0500 More workflow fixes diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 91a8c7df0bc..0bf32f2e8e4 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -11,10 +11,6 @@ jobs: strategy: matrix: emacs_version: - - 24.1 - - 24.2 - - 24.3 - - 24.4 - 24.5 - 25.1 - 25.2 commit 340144071499f677e8669352e15b04ede6b35984 Author: Justin Burkett Date: Thu Feb 6 21:48:04 2020 -0500 Fix workflow diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 8a7ad41d616..91a8c7df0bc 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -7,7 +7,7 @@ on: jobs: build: - runs-on: [ubuntu-latest, macos-latest] + runs-on: ubuntu-latest strategy: matrix: emacs_version: commit da1abb4d9f59714d8d3d5201c78a6b88886f92cd Author: Justin Burkett Date: Thu Feb 6 21:46:12 2020 -0500 Fix previous commit diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 3af184721c4..8a7ad41d616 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -1,6 +1,6 @@ name: which-key-test-workflow on: - pull-request: + pull_request: push: branches: - master commit a66bf9336a2499d1231d460ff35c56db1df477ac Author: Justin Burkett Date: Thu Feb 6 21:44:46 2020 -0500 Try purcell's workflow action diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml new file mode 100644 index 00000000000..3af184721c4 --- /dev/null +++ b/.github/workflows/test.yml @@ -0,0 +1,33 @@ +name: which-key-test-workflow +on: + pull-request: + push: + branches: + - master + +jobs: + build: + runs-on: [ubuntu-latest, macos-latest] + strategy: + matrix: + emacs_version: + - 24.1 + - 24.2 + - 24.3 + - 24.4 + - 24.5 + - 25.1 + - 25.2 + - 25.3 + - 26.1 + - 26.2 + - 26.3 + - snapshot + steps: + - uses: purcell/setup-emacs@master + with: + version: ${{ matrix.emacs_version }} + + - uses: actions/checkout@v2 + - name: Run tests + run: 'emacs -Q -batch -L . -l which-key-tests.el -f ert-run-tests-batch-and-exit' commit fcc509f49352245dc8ca26054585b0d8ccccc975 Author: Justin Burkett Date: Thu Feb 6 21:31:18 2020 -0500 Update travis versions diff --git a/.travis.yml b/.travis.yml index 105d1eabca5..60d8d31e675 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,11 +1,9 @@ # language: emacs-lisp env: - - 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-25.3-travis - EVM_EMACS=emacs-26.1-travis + - EVM_EMACS=emacs-26.2-travis + - EVM_EMACS=emacs-26.3-travis - EVM_EMACS=emacs-git-snapshot-travis before_install: commit d1dfddcd1e3eaa418daa76414109994451044cdd Author: Henrik Lissner Date: Thu Jan 2 16:41:11 2020 -0500 Refactor regexp & fix incompatibility + error diff --git a/which-key.el b/which-key.el index 2adda882efd..09f50417ab7 100644 --- a/which-key.el +++ b/which-key.el @@ -1671,12 +1671,17 @@ and `which-key-show-docstrings' is non-nil. If return the docstring." (let* ((orig-sym (intern original)) (doc (when (commandp orig-sym) - (string-trim-left - (documentation orig-sym) - (concat "\\(?::" - "\\(?:\\(?:after\\|before\\)\\(?:-\\(?:until\\|while\\)\\)?\\|around\\|override\\|filter-\\(?:args\\|return\\)\\)" + (documentation orig-sym))) + (doc (when doc + (replace-regexp-in-string + (concat "^\\(?::" + (regexp-opt '("around" "override" + "after" "after-until" "after-while" + "before" "before-until" "before-while" + "filter-args" "filter-return")) " advice: [^\n]+\n" - "\\)+\n")))) + "\\)+\n") + "" doc))) (docstring (when doc (which-key--propertize (car (split-string doc "\n")) 'face 'which-key-docstring-face)))) commit b11227b24be1c56b31380395f266983e889a7f8d Author: Henrik Lissner Date: Wed Dec 25 20:27:17 2019 -0500 Strip out advice in command docstrings diff --git a/which-key.el b/which-key.el index de96a498fb2..2adda882efd 100644 --- a/which-key.el +++ b/which-key.el @@ -1671,7 +1671,12 @@ and `which-key-show-docstrings' is non-nil. If return the docstring." (let* ((orig-sym (intern original)) (doc (when (commandp orig-sym) - (documentation orig-sym))) + (string-trim-left + (documentation orig-sym) + (concat "\\(?::" + "\\(?:\\(?:after\\|before\\)\\(?:-\\(?:until\\|while\\)\\)?\\|around\\|override\\|filter-\\(?:args\\|return\\)\\)" + " advice: [^\n]+\n" + "\\)+\n")))) (docstring (when doc (which-key--propertize (car (split-string doc "\n")) 'face 'which-key-docstring-face)))) commit 45bfcd3041942a3938791bfa34f28f2a9827d42a Author: Justin Burkett Date: Mon Feb 3 20:57:53 2020 -0500 Make which-key-show prefix mode-line work like top and bottom Fixes #234 diff --git a/which-key.el b/which-key.el index d343be0fc7c..de96a498fb2 100644 --- a/which-key.el +++ b/which-key.el @@ -1556,7 +1556,7 @@ no title exists." ((not (string-equal repl-res "")) repl-res) ((and (eq which-key-show-prefix 'echo) alternate) alternate) - ((and (member which-key-show-prefix '(bottom top)) + ((and (member which-key-show-prefix '(bottom top mode-line)) (eq which-key-side-window-location 'bottom) echo-keystrokes) (if alternate alternate commit db3d003e903deb07394b4e572206f809578278c6 Author: Justin Burkett Date: Sun Jan 19 15:10:12 2020 -0500 Add full keymap versions of show-{major,minor}-mode Fixes #236 diff --git a/which-key.el b/which-key.el index 1da0cfb019e..d343be0fc7c 100644 --- a/which-key.el +++ b/which-key.el @@ -2290,7 +2290,7 @@ after first page." (which-key--create-buffer-and-show nil nil nil "Top-level bindings")) ;;;###autoload -(defun which-key-show-major-mode () +(defun which-key-show-major-mode (&optional all) "Show top-level bindings in the map of the current major mode. This function will also detect evil bindings made using @@ -2299,12 +2299,23 @@ current evil state. " (interactive) (let ((map-sym (intern (format "%s-map" major-mode)))) (if (and (boundp map-sym) (keymapp (symbol-value map-sym))) - (which-key--create-buffer-and-show - nil nil + (which-key--show-keymap + "Major-mode bindings" + (symbol-value map-sym) (apply-partially #'which-key--map-binding-p (symbol-value map-sym)) - "Major-mode bindings") + all) (message "which-key: No map named %s" map-sym)))) +;;;###autoload +(defun which-key-show-full-major-mode () + "Show all bindings in the map of the current major mode. + +This function will also detect evil bindings made using +`evil-define-key' in this map. These bindings will depend on the +current evil state. " + (interactive) + (which-key-show-major-mode t)) + ;;;###autoload (defun which-key-dump-bindings (prefix buffer-name) "Dump bindings from PREFIX into buffer named BUFFER-NAME. @@ -2485,7 +2496,7 @@ selected interactively from all available keymaps." nil t)) ;;;###autoload -(defun which-key-show-minor-mode-keymap () +(defun which-key-show-minor-mode-keymap (&optional all) "Show the top-level bindings in KEYMAP using which-key. KEYMAP is selected interactively by mode in `minor-mode-map-alist'." (interactive) @@ -2501,12 +2512,19 @@ is selected interactively by mode in `minor-mode-map-alist'." 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))))) + (cdr (assq mode-sym minor-mode-map-alist)) + all))) +;;;###autoload +(defun which-key-show-full-minor-mode-keymap () + "Show all bindings in KEYMAP using which-key. KEYMAP +is selected interactively by mode in `minor-mode-map-alist'." + (interactive) + (which-key-show-minor-mode-keymap t)) (defun which-key--show-keymap - (keymap-name keymap &optional prior-args all no-paging) + (keymap-name keymap &optional prior-args all no-paging filter) (when prior-args (push prior-args which-key--prior-show-keymap-args)) - (let ((bindings (which-key--get-bindings nil keymap nil all))) + (let ((bindings (which-key--get-bindings nil keymap filter all))) (if (= (length bindings) 0) (message "which-key: No bindings found in %s" keymap-name) (cond ((listp which-key-side-window-location) commit 9d1de2f1273135cafc567e7ae43a3f6ca8f32f6b Author: Henrik Lissner Date: Thu Jan 2 16:41:11 2020 -0500 Refactor regexp & fix incompatibility + error diff --git a/which-key.el b/which-key.el index 74de73741ea..c8029b7d723 100644 --- a/which-key.el +++ b/which-key.el @@ -1671,12 +1671,17 @@ and `which-key-show-docstrings' is non-nil. If return the docstring." (let* ((orig-sym (intern original)) (doc (when (commandp orig-sym) - (string-trim-left - (documentation orig-sym) - (concat "\\(?::" - "\\(?:\\(?:after\\|before\\)\\(?:-\\(?:until\\|while\\)\\)?\\|around\\|override\\|filter-\\(?:args\\|return\\)\\)" + (documentation orig-sym))) + (doc (when doc + (replace-regexp-in-string + (concat "^\\(?::" + (regexp-opt '("around" "override" + "after" "after-until" "after-while" + "before" "before-until" "before-while" + "filter-args" "filter-return")) " advice: [^\n]+\n" - "\\)+\n")))) + "\\)+\n") + "" doc))) (docstring (when doc (which-key--propertize (car (split-string doc "\n")) 'face 'which-key-docstring-face)))) commit 0d0af8a0a291aec409992bfcdae06dc36e2634b4 Author: Henrik Lissner Date: Wed Dec 25 20:27:17 2019 -0500 Strip out advice in command docstrings diff --git a/which-key.el b/which-key.el index 1da0cfb019e..74de73741ea 100644 --- a/which-key.el +++ b/which-key.el @@ -1671,7 +1671,12 @@ and `which-key-show-docstrings' is non-nil. If return the docstring." (let* ((orig-sym (intern original)) (doc (when (commandp orig-sym) - (documentation orig-sym))) + (string-trim-left + (documentation orig-sym) + (concat "\\(?::" + "\\(?:\\(?:after\\|before\\)\\(?:-\\(?:until\\|while\\)\\)?\\|around\\|override\\|filter-\\(?:args\\|return\\)\\)" + " advice: [^\n]+\n" + "\\)+\n")))) (docstring (when doc (which-key--propertize (car (split-string doc "\n")) 'face 'which-key-docstring-face)))) commit 1e3640e48c31f8062f018b5fc84acad696a0ea2a Author: Justin Burkett Date: Sat Dec 21 13:57:34 2019 -0500 Make next page hint more consistent diff --git a/which-key.el b/which-key.el index f3334e128d9..1da0cfb019e 100644 --- a/which-key.el +++ b/which-key.el @@ -2049,9 +2049,10 @@ max-lines max-width avl-lines avl-width (which-key--pages-height result)) (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 (key-description (vector help-char))) (key (if paging-key-bound - which-key-paging-key - (key-description (vector help-char))))) + (concat key " or " which-key-paging-key) + key))) (when which-key-use-C-h-commands (which-key--propertize (format "[%s paging/help]" key) 'face 'which-key-note-face)))) commit 8554a9f171d565d13ff5c18d594ae055adcd53f1 Author: Justin Burkett Date: Sat Dec 21 13:47:54 2019 -0500 Generalize C-h commands to use help-char help-char defaults to C-h. This removes the assumption that help-char is set to C-h. See #228 diff --git a/which-key.el b/which-key.el index 1a0f5c68f65..f3334e128d9 100644 --- a/which-key.el +++ b/which-key.el @@ -407,18 +407,20 @@ prefixes in `which-key-paging-prefixes'" ;; :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." + "Use C-h (or whatever `help-char' is set to) 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-show-early-on-C-h nil - "Show the which-key buffer before if C-h is pressed in the -middle of a prefix before the which-key buffer would normally be -triggered through the idle delay. If combined with the following -settings, which-key will effectively only show when triggered -\"manually\" using C-h. + "Show the which-key buffer before if C-h (or whatever +`help-char' is set to) is pressed in the middle of a prefix +before the which-key buffer would normally be triggered through +the idle delay. If combined with the following settings, +which-key will effectively only show when triggered \"manually\" +using C-h. \(setq `which-key-idle-delay' 10000) \(setq `which-key-idle-secondary-delay' 0.05) @@ -435,11 +437,11 @@ Note that `which-key-idle-delay' should be set before turning on (defvar which-key-C-h-map (let ((map (make-sparse-keymap))) - (dolist (bind '(("\C-a" . which-key-abort) + (dolist (bind `(("\C-a" . which-key-abort) ("a" . which-key-abort) ("\C-d" . which-key-toggle-docstrings) ("d" . which-key-toggle-docstrings) - ("\C-h" . which-key-show-standard-help) + (,(vector help-char) . 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) @@ -2047,7 +2049,9 @@ max-lines max-width avl-lines avl-width (which-key--pages-height result)) (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"))) + (key (if paging-key-bound + which-key-paging-key + (key-description (vector help-char))))) (when which-key-use-C-h-commands (which-key--propertize (format "[%s paging/help]" key) 'face 'which-key-note-face)))) @@ -2094,7 +2098,7 @@ including prefix arguments." (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)) + (define-key map (vector help-char) #'which-key-C-h-dispatch)) map))) (defun which-key--process-page (pages-obj) @@ -2513,14 +2517,18 @@ is selected interactively by mode in `minor-mode-map-alist'." (which-key--create-pages bindings nil keymap-name)) (which-key--show-page))) (unless no-paging - (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)) + (let* ((key (read-key)) + (key-desc (key-description (list key))) + (next-def (lookup-key keymap (vector key)))) + (cond ((and which-key-use-C-h-commands + (numberp key) (= key help-char)) (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))) + (which-key--show-keymap + (concat keymap-name " " key-desc) + next-def + (cons keymap-name keymap))) (t (which-key--hide-popup)))))))) (defun which-key--evil-operator-filter (binding) @@ -2551,18 +2559,18 @@ is selected interactively by mode in `minor-mode-map-alist'." formatted-keys nil "evil operator/motion keys")) (which-key--show-page))))) - (let* ((key (key-description (list (read-key))))) - (when (member key '("f" "F" "t" "T" "`")) + (let* ((key (read-key))) + (when (member key '(?f ?F ?t ?T ?`)) ;; these keys trigger commands that read the next char manually (setq which-key--inhibit-next-operator-popup t)) - (cond ((and which-key-use-C-h-commands (string= "C-h" key)) + (cond ((and which-key-use-C-h-commands (numberp key) (= key help-char)) (which-key-C-h-dispatch)) - ((string= key "ESC") + ((and (numberp key) (= key ?\C-\[)) (which-key--hide-popup) (keyboard-quit)) (t (which-key--hide-popup) - (setq unread-command-events (listify-key-sequence key)))))))) + (setq unread-command-events (vector key)))))))) (defun which-key--create-buffer-and-show (&optional prefix-keys from-keymap filter prefix-title) commit dcb9820c2decd326465ec3dfc792d30429cec564 Author: Justin Burkett Date: Wed Nov 27 12:00:57 2019 -0500 Default to imprecise window fitting on terminal See #225. diff --git a/which-key.el b/which-key.el index 88775d4b839..1a0f5c68f65 100644 --- a/which-key.el +++ b/which-key.el @@ -341,12 +341,13 @@ a percentage out of the frame's height." :group 'which-key :type 'integer) -(defcustom which-key-allow-imprecise-window-fit nil +(defcustom which-key-allow-imprecise-window-fit (not (display-graphic-p)) "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" +See https://github.com/justbur/emacs-which-key/issues/130 +and https://github.com/justbur/emacs-which-key/issues/225." :group 'which-key :type 'boolean) commit a916c9ae28e961922d8d8419e633f9321fcdbe53 Author: Jonas Bernoulli Date: Mon Nov 11 20:51:32 2019 +0100 Fix typos (#222) diff --git a/README.org b/README.org index b21711f586a..7b0de1c3cb7 100644 --- a/README.org +++ b/README.org @@ -473,7 +473,7 @@ ;; 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 + ;; Use additional 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) diff --git a/which-key.el b/which-key.el index 7a495ec097a..88775d4b839 100644 --- a/which-key.el +++ b/which-key.el @@ -110,7 +110,7 @@ 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 +number if you are seeing characters get cutoff on the right side of the which-key popup." :group 'which-key :type 'integer) @@ -1538,7 +1538,7 @@ in order for which-key to allow looking up a description for the key." (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 +`which-key--prefix-title-alist'. An empty string is returned if no title exists." (cond ((not (string-equal keys "")) commit 42a25055163141165aa0269dbca69735e704825c Author: Justin Burkett Date: Thu Aug 1 22:40:30 2019 -0400 Rework implementation of manual updating Instead of having people mess with prefix-help-command, use a new variable which-key-show-early-on-C-h and control everything through which-key-C-h-dispatch. diff --git a/README.org b/README.org index ee573886365..b21711f586a 100644 --- a/README.org +++ b/README.org @@ -3,7 +3,7 @@ ** Recent Changes -*** 2019-07-31: Added =which-key-manual-update= +*** 2019-08-01: Added =which-key-show-early-on-C-h= Allows one to trigger =which-key= on demand, rather than automatically. See the docstring and [[#manual-activation][Manual Activation]]. @@ -28,7 +28,7 @@ ** Table of Contents :TOC_3: - [[#which-key][which-key]] - [[#recent-changes][Recent Changes]] - - [[#2019-07-31-added-which-key-manual-update][2019-07-31: Added =which-key-manual-update=]] + - [[#2019-08-01-added-which-key-show-early-on-c-h][2019-08-01: Added =which-key-show-early-on-C-h=]] - [[#2017-12-13-added-which-key-enable-extended-define-key][2017-12-13: Added =which-key-enable-extended-define-key=]] - [[#2017-11-13-added-which-key-show-major-mode][2017-11-13: Added =which-key-show-major-mode=]] - [[#introduction][Introduction]] @@ -142,13 +142,13 @@ along the following lines #+BEGIN_SRC emacs-lisp - ;; make sure which-key doesn't show normally - (setq which-key-idle-delay 1000) - ;; which-key-manual-update uses this variable to control refreshing the - ;; which-key buffer after new keypresses + ;; Allow C-h to trigger which-key before it is done automatically + (setq which-key-show-early-on-C-h t) + ;; make sure which-key doesn't show normally but refreshes quickly after it is + ;; triggered. + (setq which-key-idle-delay 10000) (setq which-key-idle-secondary-delay 0.05) (which-key-mode) - (setq prefix-help-command 'which-key-manual-update) #+END_SRC This will prevent which-key from showing automatically, and allow you to use diff --git a/which-key.el b/which-key.el index 8937436bd22..7a495ec097a 100644 --- a/which-key.el +++ b/which-key.el @@ -412,6 +412,21 @@ prefixes in `which-key-paging-prefixes'" :group 'which-key :type 'boolean) +(defcustom which-key-show-early-on-C-h nil + "Show the which-key buffer before if C-h is pressed in the +middle of a prefix before the which-key buffer would normally be +triggered through the idle delay. If combined with the following +settings, which-key will effectively only show when triggered +\"manually\" using C-h. + +\(setq `which-key-idle-delay' 10000) +\(setq `which-key-idle-secondary-delay' 0.05) + +Note that `which-key-idle-delay' should be set before turning on +`which-key-mode'. " + :group 'which-key + :type 'boolean) + (defcustom which-key-is-verbose nil "Whether to warn about potential mistakes in configuration." :group 'which-key @@ -791,7 +806,8 @@ problems at github. If DISABLE is non-nil disable support." (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 + (when (or which-key-use-C-h-commands + which-key-show-early-on-C-h) (setq prefix-help-command #'which-key-C-h-dispatch)) (when which-key-show-remaining-keys (add-hook 'pre-command-hook #'which-key--lighter-restore)) @@ -2345,40 +2361,52 @@ PREFIX should be a string suitable for `kbd'." `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 (which-key--current-key-string)) - (full-prefix (which-key--full-prefix prefix-keys current-prefix-arg t)) - (prompt (concat (when (string-equal prefix-keys "") - (which-key--propertize - (concat " " - (which-key--pages-prefix-title - which-key--pages-obj)) - 'face 'which-key-note-face)) - full-prefix - (which-key--propertize - (substitute-command-keys - (concat - " \\" - " \\[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-toggle-docstrings]" - which-key-separator "toggle-docstrings," - " \\[which-key-show-standard-help]" - which-key-separator "help," - " \\[which-key-abort]" - which-key-separator "abort" - " 1..9" - which-key-separator "digit-arg")) - '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 key) (which-key-turn-page 0))))) + (cond ((and (not (which-key--popup-showing-p)) + which-key-show-early-on-C-h) + (let* ((current-prefix + (butlast + (listify-key-sequence (which-key--this-command-keys))))) + (which-key-reload-key-sequence current-prefix) + (if which-key-idle-secondary-delay + (which-key--start-timer which-key-idle-secondary-delay t) + (which-key--start-timer 0.05 t)))) + ((not (which-key--popup-showing-p)) + (which-key-show-standard-help)) + (t + (if (not (which-key--popup-showing-p)) + (which-key-show-standard-help) + (let* ((prefix-keys (which-key--current-key-string)) + (full-prefix (which-key--full-prefix prefix-keys current-prefix-arg t)) + (prompt (concat (when (string-equal prefix-keys "") + (which-key--propertize + (concat " " + (which-key--pages-prefix-title + which-key--pages-obj)) + 'face 'which-key-note-face)) + full-prefix + (which-key--propertize + (substitute-command-keys + (concat + " \\" + " \\[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-toggle-docstrings]" + which-key-separator "toggle-docstrings," + " \\[which-key-show-standard-help]" + which-key-separator "help," + " \\[which-key-abort]" + which-key-separator "abort" + " 1..9" + which-key-separator "digit-arg")) + '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 key) (which-key-turn-page 0))))))) ;;; Update @@ -2584,28 +2612,6 @@ Finally, show the buffer." (kbd which-key--god-mode-key-string)))) this-command-keys)) -;;;###autoload -(defun which-key-manual-update () - "Force which-key update. - -This command is intended to be used for `prefix-help-command'. An -example configuration for using this command is the following. - -\(setq which-key-idle-delay 1000) -\(setq which-key-idle-secondary-delay 0.05) -\(which-key-mode) -\(setq prefix-help-command 'which-key-manual-update)" - (interactive) - (if (which-key--popup-showing-p) - (which-key-C-h-dispatch) - (let* ((current-prefix - (butlast - (listify-key-sequence (which-key--this-command-keys))))) - (which-key-reload-key-sequence current-prefix) - (if which-key-idle-secondary-delay - (which-key--start-timer which-key-idle-secondary-delay t) - (which-key--start-timer 0.05 t))))) - (defun which-key--update () "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." commit a256c4bce66d3805af07cc9f3dec5baeae1808de Author: Justin Burkett Date: Thu Aug 1 15:31:33 2019 -0400 Use which-key-idle-secondary-delay value in manual updates diff --git a/README.org b/README.org index a4133449149..ee573886365 100644 --- a/README.org +++ b/README.org @@ -142,10 +142,13 @@ along the following lines #+BEGIN_SRC emacs-lisp - ;; make sure which-key doesn't show normally - (setq which-key-idle-delay 1000) - (which-key-mode) - (setq prefix-help-command 'which-key-manual-update) + ;; make sure which-key doesn't show normally + (setq which-key-idle-delay 1000) + ;; which-key-manual-update uses this variable to control refreshing the + ;; which-key buffer after new keypresses + (setq which-key-idle-secondary-delay 0.05) + (which-key-mode) + (setq prefix-help-command 'which-key-manual-update) #+END_SRC This will prevent which-key from showing automatically, and allow you to use diff --git a/which-key.el b/which-key.el index b6ae9125f1e..8937436bd22 100644 --- a/which-key.el +++ b/which-key.el @@ -2588,12 +2588,13 @@ Finally, show the buffer." (defun which-key-manual-update () "Force which-key update. -This command is intended to be used for `prefix-help-command', as -follows +This command is intended to be used for `prefix-help-command'. An +example configuration for using this command is the following. -\(setq prefix-help-command 'which-key-manual-update). - -This should be set after activating `which-key-mode'." +\(setq which-key-idle-delay 1000) +\(setq which-key-idle-secondary-delay 0.05) +\(which-key-mode) +\(setq prefix-help-command 'which-key-manual-update)" (interactive) (if (which-key--popup-showing-p) (which-key-C-h-dispatch) @@ -2601,7 +2602,9 @@ This should be set after activating `which-key-mode'." (butlast (listify-key-sequence (which-key--this-command-keys))))) (which-key-reload-key-sequence current-prefix) - (which-key--start-timer 0.05 t)))) + (if which-key-idle-secondary-delay + (which-key--start-timer which-key-idle-secondary-delay t) + (which-key--start-timer 0.05 t))))) (defun which-key--update () "Function run by timer to possibly trigger @@ -2689,7 +2692,11 @@ This should be set after activating `which-key-mode'." (not (equal (which-key--current-prefix) (which-key--this-command-keys))))) (cancel-timer which-key--paging-timer) - (which-key--start-timer)))))) + (if which-key-idle-secondary-delay + ;; we haven't executed a command yet so the secandary + ;; timer is more relevant here + (which-key--start-timer which-key-idle-secondary-delay t) + (which-key--start-timer))))))) (provide 'which-key) ;;; which-key.el ends here commit 2cb5ceba55fb9c671bcf794a795059673633113a Author: Justin Burkett Date: Wed Jul 31 13:59:11 2019 -0400 Fix paging in which-key-manual-update diff --git a/which-key.el b/which-key.el index 703d9f58912..b6ae9125f1e 100644 --- a/which-key.el +++ b/which-key.el @@ -445,6 +445,7 @@ prefixes in `which-key-paging-prefixes'" "Keymap for C-h commands.") (defvar which-key--paging-functions '(which-key-C-h-dispatch + which-key-manual-update which-key-turn-page which-key-show-next-page-cycle which-key-show-next-page-no-cycle @@ -2594,11 +2595,13 @@ follows This should be set after activating `which-key-mode'." (interactive) - (let* ((current-prefix - (butlast - (listify-key-sequence (which-key--this-command-keys))))) - (which-key-reload-key-sequence current-prefix) - (which-key--start-timer 0 t))) + (if (which-key--popup-showing-p) + (which-key-C-h-dispatch) + (let* ((current-prefix + (butlast + (listify-key-sequence (which-key--this-command-keys))))) + (which-key-reload-key-sequence current-prefix) + (which-key--start-timer 0.05 t)))) (defun which-key--update () "Function run by timer to possibly trigger commit c47c72d1fe0d2e15482eee4af1bff2881bbe218e Author: Justin Burkett Date: Wed Jul 31 12:31:57 2019 -0400 Cleanup whitespace in README diff --git a/README.org b/README.org index c9992daf0d7..a4133449149 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,6 @@ -* which-key +* 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 *** 2019-07-31: Added =which-key-manual-update= @@ -24,7 +24,7 @@ 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]] @@ -63,7 +63,7 @@ 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 @@ -71,66 +71,66 @@ (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=. Also, the paging commands do not work reliably with the minibuffer option. Use the side window on the bottom @@ -162,7 +162,7 @@ - =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=. @@ -181,24 +181,24 @@ #+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, + ;; 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 @@ -208,11 +208,11 @@ #+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=, @@ -220,8 +220,8 @@ =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) @@ -243,14 +243,14 @@ (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=. - + **** Automatic A newer option is to set =which-key-enable-extended-define-key= which advises =define-key= to allow which-key to pre-process its arguments. The @@ -272,70 +272,70 @@ **** "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/pdcawley][@pdcawley]] in [[https://github.com/justbur/emacs-which-key/pull/147][PR #147]]. - + #+BEGIN_SRC emacs-lisp - (push (cons '(nil . "paredit-mode") + (push (cons '(nil . "paredit-mode") (lambda (kb) (cons (car kb) (if paredit-mode @@ -343,19 +343,19 @@ "[ ] paredit-mode")))) which-key-replacement-alist) #+END_SRC - - The box will be checked if =paredit-mode= is currently active. - + + 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) @@ -368,9 +368,9 @@ ;; 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 @@ -378,7 +378,7 @@ 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 @@ -392,38 +392,38 @@ 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 == to the relevant command. - + #+BEGIN_SRC emacs-lisp (define-key which-key-mode-map (kbd "C-x ") 'which-key-C-h-dispatch) #+END_SRC - - This is completely equivalent to - + + This is completely equivalent to + #+BEGIN_SRC emacs-lisp (setq which-key-paging-prefixes '("C-x")) (setq which-key-paging-key "") #+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 | @@ -435,32 +435,32 @@ | =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. @@ -517,7 +517,7 @@ 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. + 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 @@ -528,7 +528,7 @@ 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]] ** Known Issues commit 5cec1133cff535708feda43b8f6daa4dccbc28a2 Author: Justin Burkett Date: Wed Jul 31 12:31:37 2019 -0400 Announce which-key-manual-update diff --git a/README.org b/README.org index 49915668722..c9992daf0d7 100644 --- a/README.org +++ b/README.org @@ -3,6 +3,10 @@ ** Recent Changes +*** 2019-07-31: Added =which-key-manual-update= + Allows one to trigger =which-key= on demand, rather than automatically. See + the docstring and [[#manual-activation][Manual Activation]]. + *** 2017-12-13: Added =which-key-enable-extended-define-key= Allows for a concise syntax to specify replacement text using =define-key= or alternatives that use =define-key= internally. See the docstring and @@ -24,6 +28,7 @@ ** Table of Contents :TOC_3: - [[#which-key][which-key]] - [[#recent-changes][Recent Changes]] + - [[#2019-07-31-added-which-key-manual-update][2019-07-31: Added =which-key-manual-update=]] - [[#2017-12-13-added-which-key-enable-extended-define-key][2017-12-13: Added =which-key-enable-extended-define-key=]] - [[#2017-11-13-added-which-key-show-major-mode][2017-11-13: Added =which-key-show-major-mode=]] - [[#introduction][Introduction]] @@ -35,6 +40,7 @@ - [[#side-window-right-option][Side Window Right Option]] - [[#side-window-right-then-bottom][Side Window Right then Bottom]] - [[#minibuffer-option][Minibuffer Option]] + - [[#manual-activation][Manual Activation]] - [[#additional-commands][Additional Commands]] - [[#special-features-and-configuration-options][Special Features and Configuration Options]] - [[#popup-type-options][Popup Type Options]] @@ -129,7 +135,23 @@ variable =max-mini-window-height=. Also, the paging commands do not work reliably with the minibuffer option. Use the side window on the bottom option if you need paging. - + +** Manual Activation + #+NAME: #manual-activation + If you only want the =which-key= popup when you need it, you can try a setup + along the following lines + + #+BEGIN_SRC emacs-lisp + ;; make sure which-key doesn't show normally + (setq which-key-idle-delay 1000) + (which-key-mode) + (setq prefix-help-command 'which-key-manual-update) + #+END_SRC + + This will prevent which-key from showing automatically, and allow you to use + =C-h= in the middle of a key sequence to show the =which-key= buffer and keep + it open for the remainder of the key sequence. + ** 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 commit 5cbfccd5fec9b8f75b0933d2f0350592cebd32e8 Author: Justin Burkett Date: Wed Jul 31 12:12:32 2019 -0400 Add which-key-manual-update Intended to be used for prefix-help-command Ref #66 diff --git a/which-key.el b/which-key.el index c47c576e55e..703d9f58912 100644 --- a/which-key.el +++ b/which-key.el @@ -2583,6 +2583,23 @@ Finally, show the buffer." (kbd which-key--god-mode-key-string)))) this-command-keys)) +;;;###autoload +(defun which-key-manual-update () + "Force which-key update. + +This command is intended to be used for `prefix-help-command', as +follows + +\(setq prefix-help-command 'which-key-manual-update). + +This should be set after activating `which-key-mode'." + (interactive) + (let* ((current-prefix + (butlast + (listify-key-sequence (which-key--this-command-keys))))) + (which-key-reload-key-sequence current-prefix) + (which-key--start-timer 0 t))) + (defun which-key--update () "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." commit da2e093e916bf9ae7512c104512b92eca8fb224e Author: Justin Burkett Date: Tue Jul 23 11:52:11 2019 -0400 Add no-paging optional arg to which-key-show-keymap diff --git a/which-key.el b/which-key.el index 1d3c21d711f..c47c576e55e 100644 --- a/which-key.el +++ b/which-key.el @@ -2429,12 +2429,16 @@ Only if no bindings fit fallback to LOC2." 'which-key-keymap-history))) ;;;###autoload -(defun which-key-show-keymap (keymap) +(defun which-key-show-keymap (keymap &optional no-paging) "Show the top-level bindings in KEYMAP using which-key. KEYMAP -is selected interactively from all available keymaps." +is selected interactively from all available keymaps. + +If NO-PAGING is non-nil, which-key will not intercept subsequent +keypresses for the paging functionality." (interactive (list (which-key--read-keymap))) (which-key--show-keymap (symbol-name keymap) - (symbol-value keymap))) + (symbol-value keymap) + nil nil no-paging)) ;;;###autoload (defun which-key-show-full-keymap (keymap) @@ -2464,7 +2468,8 @@ is selected interactively by mode in `minor-mode-map-alist'." (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 all) +(defun which-key--show-keymap + (keymap-name keymap &optional prior-args all no-paging) (when prior-args (push prior-args which-key--prior-show-keymap-args)) (let ((bindings (which-key--get-bindings nil keymap nil all))) (if (= (length bindings) 0) @@ -2477,15 +2482,16 @@ is selected interactively by mode in `minor-mode-map-alist'." (t (setq which-key--pages-obj (which-key--create-pages bindings nil keymap-name)) (which-key--show-page))) - (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))))))) + (unless no-paging + (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 (binding) (let ((def (intern (cdr binding)))) commit cf8572a6888547451e6af461b374f3a5fde28f5d Author: Justin Burkett Date: Tue Jul 23 11:34:49 2019 -0400 which-key-persistent-popup-p -> which-key-persistent-popup diff --git a/which-key.el b/which-key.el index 9b147bddae3..1d3c21d711f 100644 --- a/which-key.el +++ b/which-key.el @@ -453,7 +453,7 @@ prefixes in `which-key-paging-prefixes'" which-key-undo-key which-key-undo)) -(defvar which-key-persistent-popup-p nil +(defvar which-key-persistent-popup nil "Whether or not to disable `which-key--hide-popup'.") (defcustom which-key-hide-alt-key-translations t @@ -1083,7 +1083,7 @@ total height." (defun which-key--hide-popup () "This function is called to hide the which-key buffer." - (unless (or which-key-persistent-popup-p + (unless (or which-key-persistent-popup (member real-this-command which-key--paging-functions)) (setq which-key--last-try-2-loc nil) (setq which-key--pages-obj nil) commit fb2bc8fd08fc39dd5527b13a65717399c5d6821b Author: Uros Perisic Date: Sun Jul 21 02:29:54 2019 +0800 Add which-key-persistent-popup-p variable (#213) I did not remove the `pre-command-hook', because that would require me to add the hook back every time `which-key--hide-popup' is called, which seems excessive. Hercules.el already handles this more conservatively. But if you want me to, I can add it. diff --git a/which-key.el b/which-key.el index 99318d5f320..9b147bddae3 100644 --- a/which-key.el +++ b/which-key.el @@ -453,6 +453,9 @@ prefixes in `which-key-paging-prefixes'" which-key-undo-key which-key-undo)) +(defvar which-key-persistent-popup-p nil + "Whether or not to disable `which-key--hide-popup'.") + (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 @@ -1080,13 +1083,13 @@ total height." (defun which-key--hide-popup () "This function is called to hide the which-key buffer." - (unless (member real-this-command which-key--paging-functions) + (unless (or which-key-persistent-popup-p + (member real-this-command which-key--paging-functions)) (setq which-key--last-try-2-loc nil) (setq which-key--pages-obj nil) (setq which-key--automatic-display nil) (setq which-key--prior-show-keymap-args nil) - (when (and which-key-idle-secondary-delay - which-key--secondary-timer-active) + (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 commit ba03e7e5bcbe3f7d95be2cfddd71454151bb98c8 Author: D.K Date: Wed May 29 04:14:09 2019 +0300 Add translation keymap support (#210) diff --git a/which-key-tests.el b/which-key-tests.el index 3e75d6fa62c..cff7fab56e6 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -130,20 +130,23 @@ (define-key map "c" "c") (define-key map "dd" "dd") (define-key map "eee" "eee") + (define-key map "f" [123 45 6]) (should (equal (sort (which-key--get-keymap-bindings map) (lambda (a b) (string-lessp (car a) (car b)))) '(("b" . "ignore") ("c" . "c") ("d" . "Prefix Command") - ("e" . "Prefix Command")))) + ("e" . "Prefix Command") + ("f" . "{ - C-f")))) (should (equal (sort (which-key--get-keymap-bindings map t) (lambda (a b) (string-lessp (car a) (car b)))) '(("b" . "ignore") ("c" . "c") ("d d" . "dd") - ("e e e" . "eee")))))) + ("e e e" . "eee") + ("f" . "{ - C-f")))))) (provide 'which-key-tests) ;;; which-key-tests.el ends here diff --git a/which-key.el b/which-key.el index f4b15c4806a..99318d5f320 100644 --- a/which-key.el +++ b/which-key.el @@ -1741,6 +1741,7 @@ ones. PREFIX is for internal use and should not be used." ((eq 'lambda (car-safe def)) "lambda") ((eq 'menu-item (car-safe def)) "menu-item") ((stringp def) def) + ((vectorp def) (key-description def)) (t "unknown"))) bindings :test (lambda (a b) (string= (car a) (car b))))))))) keymap) commit 77586e62b6d306bae07e4e3e093ba488724f4131 Author: Justin Burkett Date: Fri May 17 21:57:18 2019 -0400 Add which-key-dump-bindings Fixes #209 diff --git a/which-key.el b/which-key.el index 6980b78c5b9..f4b15c4806a 100644 --- a/which-key.el +++ b/which-key.el @@ -2278,6 +2278,21 @@ current evil state. " "Major-mode bindings") (message "which-key: No map named %s" map-sym)))) +;;;###autoload +(defun which-key-dump-bindings (prefix buffer-name) + "Dump bindings from PREFIX into buffer named BUFFER-NAME. + +PREFIX should be a string suitable for `kbd'." + (interactive "sPrefix: \nB") + (let* ((buffer (get-buffer-create buffer-name)) + (keys (which-key--get-bindings (kbd prefix)))) + (with-current-buffer buffer + (point-max) + (save-excursion + (dolist (key keys) + (insert (apply #'format "%s%s%s\n" key))))) + (switch-to-buffer-other-window buffer))) + ;;;###autoload (defun which-key-undo-key (&optional _) "Undo last keypress and force which-key update." commit 187ac0eb8990b62d4bfd83aac10a0ae68cdd2ff5 Author: Justin Burkett Date: Fri Mar 15 08:48:23 2019 -0400 Add note to docstring for which-key-idle-delay Ref #206 diff --git a/which-key.el b/which-key.el index 2aeaeaaa21c..6980b78c5b9 100644 --- a/which-key.el +++ b/which-key.el @@ -56,8 +56,11 @@ :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 + "Delay (in seconds) for which-key buffer to popup. This + variable should be set before activating `which-key-mode'. + +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) commit c87b0ce78213f922a725be1e0ae2dede1cf29516 Author: Justin Burkett Date: Wed Mar 6 10:18:52 2019 -0500 Add debugging messages for buffer sizing diff --git a/which-key.el b/which-key.el index 08f259d7ba5..2aeaeaaa21c 100644 --- a/which-key.el +++ b/which-key.el @@ -640,12 +640,13 @@ used.") (defvar which-key--automatic-display nil "Internal: Non-nil if popup was triggered with automatic update.") +(defvar which-key--debug-buffer-name nil + "If non-nil, use this buffer for debug messages.") (defvar which-key--multiple-locations nil) (defvar which-key--inhibit-next-operator-popup 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) (defvar which-key--evil-keys-regexp (eval-when-compile (regexp-opt '("-state")))) (defvar which-key--ignore-non-evil-keys-regexp @@ -701,6 +702,14 @@ update.") (when which-key--pages-obj (which-key--pages-prefix which-key--pages-obj))) +(defmacro which-key--debug-message (&rest msg) + `(when which-key--debug-buffer-name + (let ((buf (get-buffer-create which-key--debug-buffer-name)) + (fmt-msg (format ,@msg))) + (with-current-buffer buf + (goto-char (point-max)) + (insert "\n" fmt-msg "\n"))))) + ;;; Third-party library support ;;;; Evil @@ -1919,7 +1928,7 @@ as well as metadata." (push page-width page-widths)) (make-which-key--pages :pages (nreverse pages) - :height avl-lines + :height (if (> n-pages 1) avl-lines (min avl-lines n-keys)) :widths (nreverse page-widths) :keys/page (reverse keys/page) :page-nums (number-sequence 1 n-pages) @@ -1981,6 +1990,12 @@ is the width of the live window." (or prefix-title (which-key--maybe-get-prefix-title (key-description prefix-keys)))) + (which-key--debug-message "Frame height: %s +Minibuffer height: %s +Max dimensions: (%s,%s) +Available for bindings: (%s,%s) +Actual lines: %s" (frame-height) (window-text-height (minibuffer-window)) +max-lines max-width avl-lines avl-width (which-key--pages-height result)) result))) (defun which-key--lighter-status () @@ -2495,7 +2510,7 @@ is selected interactively by mode in `minor-mode-map-alist'." (&optional prefix-keys from-keymap filter prefix-title) "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." - (let ((start-time (when which-key--debug (current-time))) + (let ((start-time (current-time)) (formatted-keys (which-key--get-bindings prefix-keys from-keymap filter)) (prefix-desc (key-description prefix-keys))) @@ -2510,9 +2525,9 @@ Finally, show the buffer." (which-key--create-pages formatted-keys prefix-keys prefix-title)) (which-key--show-page))) - (when which-key--debug - (message "On prefix \"%s\" which-key took %.0f ms." prefix-desc - (* 1000 (float-time (time-since start-time))))))) + (which-key--debug-message + "On prefix \"%s\" which-key took %.0f ms." prefix-desc + (* 1000 (float-time (time-since start-time)))))) (defun which-key--this-command-keys () "Version of `this-single-command-keys' corrected for key-chords and god-mode." commit 51c485f16b4724488bcf2cbf7933fbd9eede1edd Author: Justin Burkett Date: Fri Mar 1 10:41:36 2019 -0500 Don't ignore case when making replacements Fixes #204 diff --git a/which-key.el b/which-key.el index 70a6d18ae99..08f259d7ba5 100644 --- a/which-key.el +++ b/which-key.el @@ -1406,7 +1406,8 @@ local bindings coming first. Within these categories order using ;; handled in the selection of alist (when (and (consp key-binding) (not (symbolp (car replacement)))) (let ((key-regexp (caar replacement)) - (binding-regexp (cdar replacement))) + (binding-regexp (cdar replacement)) + case-fold-search) (and (or (null key-regexp) (string-match-p key-regexp (car key-binding))) commit 9c5922edbb9ba6d866ac169ea65f100bc96adf72 Author: Justin Burkett Date: Mon Feb 25 14:10:06 2019 -0500 Version 3.3.2 diff --git a/which-key.el b/which-key.el index 068c23cb5e6..70a6d18ae99 100644 --- a/which-key.el +++ b/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.3.1 +;; Version: 3.3.2 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit d9122c48b2b702d42cf044cbb80fde2c7caf5869 Author: Justin Burkett Date: Mon Feb 25 09:57:03 2019 -0500 Always check non-major-mode replacements in which-key--maybe-replace diff --git a/which-key.el b/which-key.el index 21d159a448d..068c23cb5e6 100644 --- a/which-key.el +++ b/which-key.el @@ -1437,9 +1437,9 @@ which are strings. KEY is of the form produced by `key-binding'." one-match) (if pseudo-binding pseudo-binding - (let* ((all-repls (or (cdr-safe - (assq major-mode which-key-replacement-alist)) - which-key-replacement-alist))) + (let* ((all-repls + (append (cdr-safe (assq major-mode which-key-replacement-alist)) + which-key-replacement-alist))) (dolist (repl all-repls key-binding) (when (and (or which-key-allow-multiple-replacements (not one-match)) commit 3b184d6f0c78231f9e6c2ed95c2e8d218ae56fb8 Author: Justin Burkett Date: Sun Feb 24 22:57:31 2019 -0500 Simplify finding and matching replacements Don't try to grab all matching replacements ahead of time, because later ones may not match if earlier ones make deletions. Fixes #202 diff --git a/which-key.el b/which-key.el index 6661f76bc0b..21d159a448d 100644 --- a/which-key.el +++ b/which-key.el @@ -1401,29 +1401,18 @@ local bindings coming first. Within these categories order using (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--match-replacement (key-binding replacement) + ;; these are mode specific ones to ignore. The mode specific case is + ;; handled in the selection of alist + (when (and (consp key-binding) (not (symbolp (car replacement)))) + (let ((key-regexp (caar replacement)) + (binding-regexp (cdar replacement))) + (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))))))) (defun which-key--get-pseudo-binding (key-binding &optional prefix) (let* ((pseudo-binding @@ -1444,30 +1433,35 @@ local bindings coming first. Within these categories order using "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* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix))) + (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix)) + one-match) (if pseudo-binding pseudo-binding - (let* ((mode-res (which-key--get-replacements key-binding t)) - (all-repls (or mode-res - (which-key--get-replacements key-binding)))) + (let* ((all-repls (or (cdr-safe + (assq major-mode which-key-replacement-alist)) + which-key-replacement-alist))) (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)))))))))))) + (when (and (or which-key-allow-multiple-replacements + (not one-match)) + (which-key--match-replacement key-binding repl)) + (setq one-match t) + (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)) commit 2f5661646b771f6c5a00a8a9aaa3f183abd5f84d Author: Justin Burkett Date: Wed Nov 14 09:34:39 2018 -0500 Version 3.3.1 diff --git a/which-key.el b/which-key.el index d901a31173a..6661f76bc0b 100644 --- a/which-key.el +++ b/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.3.0 +;; Version: 3.3.1 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit 43e3e3d7641a8e1c298b37e6a277612bf0898708 Author: Justin Burkett Date: Wed Nov 14 09:32:27 2018 -0500 Fix use of describe-prefix-bindings in which-key-show-standard-help Use describe-prefix-bindings directly if we do not enter through which-key-C-h-dispatch. Fixes #198 diff --git a/which-key.el b/which-key.el index c62924da823..d901a31173a 100644 --- a/which-key.el +++ b/which-key.el @@ -2193,13 +2193,18 @@ used are reapplied to the new key sequence." "Call the command in `which-key--prefix-help-cmd-backup'. Usually this is `describe-prefix-bindings'." (interactive) - (let ((which-key-inhibit t)) + (let ((which-key-inhibit t) + (popup-showing (which-key--popup-showing-p))) (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)))) + (cond ((and (eq which-key--prefix-help-cmd-backup + 'describe-prefix-bindings) + ;; If the popup is not showing, we call + ;; `describe-prefix-bindings' directly. + popup-showing) + ;; This is essentially what `describe-prefix-bindings' does. We can't + ;; use this function directly, because the prefix will not be correct + ;; when we enter using `which-key-C-h-dispatch'. + (describe-bindings (kbd (which-key--current-key-string)))) ((functionp which-key--prefix-help-cmd-backup) (funcall which-key--prefix-help-cmd-backup))))) commit ace569b65f13526781200b479d506274637f1921 Author: Justin Burkett Date: Thu Nov 8 10:21:07 2018 -0500 Check for existence of buffer in which-key--popup-showing-p Fixes #197 diff --git a/which-key.el b/which-key.el index 09effbc7aa1..c62924da823 100644 --- a/which-key.el +++ b/which-key.el @@ -1111,7 +1111,8 @@ popup)." (delete-frame which-key--frame))) (defun which-key--popup-showing-p () - (window-live-p (get-buffer-window which-key--buffer))) + (and (bufferp which-key--buffer) + (window-live-p (get-buffer-window which-key--buffer)))) (defun which-key--show-popup (act-popup-dim) "Show the which-key buffer. commit c938bbf8d4b506d8a16bedf0059703236ce05a50 Author: Justin Burkett Date: Tue Aug 28 11:44:32 2018 -0400 Mention #130 in README diff --git a/README.org b/README.org index 4b4f96bfdb0..49915668722 100644 --- a/README.org +++ b/README.org @@ -49,6 +49,7 @@ - [[#god-mode][God-mode]] - [[#more-examples][More Examples]] - [[#nice-display-with-split-frame][Nice Display with Split Frame]] + - [[#known-issues][Known Issues]] - [[#thanks][Thanks]] ** Install @@ -508,7 +509,9 @@ #+CAPTION: which-key in a frame with 2 vertical splits [[./img/which-key-bottom-split.png]] - +** Known Issues + - A few users have reported crashes related to which-key popups when quitting + a key sequence with =C-g=. A possible fix is discussed in [[https://github.com/justbur/emacs-which-key/issues/130][this issue]]. ** Thanks Special thanks to - [[https://github.com/bmag][@bmag]] for helping with the initial development and finding many bugs. commit 013cdb7259c1ff1ce9fb7ffbc637fc368ebd8144 Author: Justin Burkett Date: Wed Jun 27 10:28:44 2018 -0400 Make Travis test on v26.1 diff --git a/.travis.yml b/.travis.yml index 918e5f19e92..105d1eabca5 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,6 +5,7 @@ env: - EVM_EMACS=emacs-25.1-travis - EVM_EMACS=emacs-25.2-travis - EVM_EMACS=emacs-25.3-travis + - EVM_EMACS=emacs-26.1-travis - EVM_EMACS=emacs-git-snapshot-travis before_install: commit ff79dfff66f880885c5893dd6fd05dc51173a476 Author: Justin Burkett Date: Thu Jun 21 15:38:47 2018 -0400 Version 3.3.0 diff --git a/which-key.el b/which-key.el index 29b38f0d4de..09effbc7aa1 100644 --- a/which-key.el +++ b/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.2.0 +;; Version: 3.3.0 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit a4095e8ee6f932e049cebd90ab41b95b869ce3e4 Author: Justin Burkett Date: Fri Jun 8 08:51:48 2018 -0400 Fix handling of duplicate (evil) bindings in show keymap diff --git a/which-key.el b/which-key.el index e4c372d4f3a..29b38f0d4de 100644 --- a/which-key.el +++ b/which-key.el @@ -1707,8 +1707,12 @@ ones. PREFIX is for internal use and should not be used." (bound-and-true-p evil-local-mode) (string-match-p (format "<%s-state>$" evil-state) key-desc)) (setq bindings - (append bindings - (which-key--get-keymap-bindings def all prefix)))) + ;; this function keeps the latter of the two duplicates + ;; which will be the evil binding + (cl-remove-duplicates + (append bindings + (which-key--get-keymap-bindings def all prefix)) + :test (lambda (a b) (string= (car a) (car b)))))) ((and (keymapp def) (string-match-p which-key--evil-keys-regexp key-desc))) ((and (keymapp def) commit 0dc4e8472254b8e4317863ca7950f2a428dcb12d Author: Justin Burkett Date: Fri Jun 1 09:46:35 2018 -0400 Use window-size-change-functions for detecting size changes Fixes #193 diff --git a/which-key.el b/which-key.el index 8c9784d8da1..e4c372d4f3a 100644 --- a/which-key.el +++ b/which-key.el @@ -782,7 +782,7 @@ problems at github. If DISABLE is non-nil disable support." (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 + (add-hook 'window-size-change-functions 'which-key--hide-popup-on-frame-size-change) (which-key--start-timer)) (setq echo-keystrokes which-key--echo-keystrokes-backup) @@ -793,7 +793,7 @@ problems at github. If DISABLE is non-nil disable support." (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 + (remove-hook 'window-size-change-functions 'which-key--hide-popup-on-frame-size-change) (which-key--stop-timer))) @@ -1092,7 +1092,7 @@ total height." (frame (which-key--hide-buffer-frame)) (custom (funcall which-key-custom-hide-popup-function)))) -(defun which-key--hide-popup-on-frame-size-change () +(defun which-key--hide-popup-on-frame-size-change (&optional _) "Hide which-key popup if the frame is resized (to trigger a new popup)." (when (which-key--frame-size-changed-p) commit 2c915407e15cc2f33d40a5efbc063596dc493991 Author: Justin Burkett Date: Wed May 30 22:02:11 2018 -0400 Add support for evil's auxiliary maps in show-keymap functions diff --git a/which-key.el b/which-key.el index e371895cb84..8c9784d8da1 100644 --- a/which-key.el +++ b/which-key.el @@ -646,6 +646,12 @@ update.") (defvar which-key--previous-frame-size nil) (defvar which-key--prefix-title-alist nil) (defvar which-key--debug nil) +(defvar which-key--evil-keys-regexp (eval-when-compile + (regexp-opt '("-state")))) +(defvar which-key--ignore-non-evil-keys-regexp + (eval-when-compile + (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" + "select-window" "switch-frame" "which-key-")))) (defvar which-key--ignore-keys-regexp (eval-when-compile (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" @@ -1692,27 +1698,39 @@ ones. PREFIX is for internal use and should not be used." (lambda (ev def) (let* ((key (append prefix (list ev))) (key-desc (key-description key))) - (unless (or (string-match-p which-key--ignore-keys-regexp key-desc) - (eq ev 'menu-bar)) - (if (and (keymapp def) - (or all - ;; event 27 is escape, so this will pick up meta - ;; bindings and hopefully not too much more - (and (numberp ev) (= ev 27)))) - (setq bindings - (append bindings - (which-key--get-keymap-bindings def t key))) - (when def - (cl-pushnew - (cons key-desc - (cond - ((keymapp def) "Prefix Command") - ((symbolp def) (copy-sequence (symbol-name def))) - ((eq 'lambda (car-safe def)) "lambda") - ((eq 'menu-item (car-safe def)) "menu-item") - ((stringp def) def) - (t "unknown"))) - bindings :test (lambda (a b) (string= (car a) (car b))))))))) + (cond ((or (string-match-p + which-key--ignore-non-evil-keys-regexp key-desc) + (eq ev 'menu-bar))) + ;; extract evil keys corresponding to current state + ((and (keymapp def) + (boundp 'evil-state) + (bound-and-true-p evil-local-mode) + (string-match-p (format "<%s-state>$" evil-state) key-desc)) + (setq bindings + (append bindings + (which-key--get-keymap-bindings def all prefix)))) + ((and (keymapp def) + (string-match-p which-key--evil-keys-regexp key-desc))) + ((and (keymapp def) + (or all + ;; event 27 is escape, so this will pick up meta + ;; bindings and hopefully not too much more + (and (numberp ev) (= ev 27)))) + (setq bindings + (append bindings + (which-key--get-keymap-bindings def t key)))) + (t + (when def + (cl-pushnew + (cons key-desc + (cond + ((keymapp def) "Prefix Command") + ((symbolp def) (copy-sequence (symbol-name def))) + ((eq 'lambda (car-safe def)) "lambda") + ((eq 'menu-item (car-safe def)) "menu-item") + ((stringp def) def) + (t "unknown"))) + bindings :test (lambda (a b) (string= (car a) (car b))))))))) keymap) bindings)) commit 4042f06564f450838c8ed79d7c0d1bce3124200d Author: Justin Burkett Date: Wed May 30 21:43:50 2018 -0400 Fix prefix bindings in which-key-show-major-mode diff --git a/which-key.el b/which-key.el index c6b89baf934..e371895cb84 100644 --- a/which-key.el +++ b/which-key.el @@ -1476,16 +1476,21 @@ which are strings. KEY is of the form produced by `key-binding'." (intern (cdr keydesc)))) (defun which-key--map-binding-p (map keydesc) + "Does MAP contain KEYDESC = (key . binding)?" (or (when (bound-and-true-p evil-state) - (eq (which-key--safe-lookup-key - map - (kbd (which-key--current-key-string - (format "<%s-state> %s" evil-state (car keydesc))))) - (intern (cdr keydesc)))) - (eq (which-key--safe-lookup-key - map (kbd (which-key--current-key-string (car keydesc)))) - (intern (cdr keydesc))))) + (let ((lookup + (which-key--safe-lookup-key + map + (kbd (which-key--current-key-string + (format "<%s-state> %s" evil-state (car keydesc))))))) + (or (eq lookup (intern (cdr keydesc))) + (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command"))))) + (let ((lookup + (which-key--safe-lookup-key + map (kbd (which-key--current-key-string (car keydesc)))))) + (or (eq lookup (intern (cdr keydesc))) + (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command")))))) (defun which-key--pseudo-key (key &optional prefix) "Replace the last key in the sequence KEY by a special symbol commit 206be7a42be71c357a8c3ff488392f0eeda2cf03 Author: Justin Burkett Date: Tue May 22 10:11:15 2018 -0400 Fix behavior of f and t in evil operator map f and t (also F and T) read characters manually, so the popup should not be shown after these commands. This only applies if which-key-show-operator-state-maps is non-nil. Fixes #191 diff --git a/which-key.el b/which-key.el index 1a4212f4fb9..c6b89baf934 100644 --- a/which-key.el +++ b/which-key.el @@ -2451,8 +2451,8 @@ is selected interactively by mode in `minor-mode-map-alist'." nil "evil operator/motion keys")) (which-key--show-page))))) (let* ((key (key-description (list (read-key))))) - (when (string= key "`") - ;; evil-goto-mark reads the next char manually + (when (member key '("f" "F" "t" "T" "`")) + ;; these keys trigger commands that read 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)) commit 8a878de16db5ff83ce78f2a43d22ed2170b3abd3 Author: Justin Burkett Date: Thu Apr 26 10:33:36 2018 -0400 Version 3.2.0 diff --git a/which-key.el b/which-key.el index e2a0d2d706c..1a4212f4fb9 100644 --- a/which-key.el +++ b/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.1.0 +;; Version: 3.2.0 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit bc97659029bffda0861a418da092656b379dd0cd Author: Michał K Date: Wed Mar 21 11:31:52 2018 +0100 Fix and improve defcustoms diff --git a/which-key.el b/which-key.el index 010266695b1..e2a0d2d706c 100644 --- a/which-key.el +++ b/which-key.el @@ -69,7 +69,7 @@ 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) + :type '(choice float (const :tag "Disabled" nil))) (defcustom which-key-echo-keystrokes (if (and echo-keystrokes (> (+ echo-keystrokes 0.01) @@ -88,7 +88,7 @@ which-key popup." "Truncate the description of keys to this length. Also adds \"..\". If nil, disable any truncation." :group 'which-key - :type 'integer) + :type '(choice integer (const :tag "Disable truncation" nil))) (defcustom which-key-add-column-padding 0 "Additional padding (number of spaces) to add to the left of @@ -115,7 +115,7 @@ of the which-key popup." (defcustom which-key-dont-use-unicode nil "If non-nil, don't use any unicode characters in default setup." :group 'which-key - :type 'integer) + :type 'boolean) (defcustom which-key-separator (if which-key-dont-use-unicode " : " " → ") @@ -189,10 +189,10 @@ 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)))) + :type '(alist :key-type (cons (choice regexp (const nil)) + (choice regexp (const nil))) + :value-type (cons (choice string (const nil)) + (choice string (const nil))))) (when (bound-and-true-p which-key-key-replacement-alist) (mapc @@ -282,7 +282,7 @@ and nil. Nil turns the feature off." "The maximum number of columns to display in the which-key buffer. nil means don't impose a maximum." :group 'which-key - :type 'integer) + :type '(choice integer (const :tag "Unbounded" nil))) (defcustom which-key-side-window-location 'bottom "Location of which-key popup when `which-key-popup-type' is side-window. @@ -585,13 +585,13 @@ 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) + :type '(choice function (const nil))) (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) + :type '(choice function (const nil))) (defcustom which-key-custom-show-popup-function nil "Variable to hold a custom show-popup function. @@ -599,7 +599,7 @@ 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) + :type '(choice function (const nil))) (defcustom which-key-lighter " WK" "Minor mode lighter to use in the mode-line." commit d19fe4e037baf8a5cd6e8c0609d3999528bb5ac9 Author: Justin Burkett Date: Thu Mar 1 13:18:43 2018 -0500 Fix switching to top-level from which-key-undo-key diff --git a/which-key.el b/which-key.el index e38571fbb24..010266695b1 100644 --- a/which-key.el +++ b/which-key.el @@ -2246,7 +2246,8 @@ current evil state. " (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))))) + (t (setq which-key--automatic-display nil) + (which-key-show-top-level))))) (defalias 'which-key-undo 'which-key-undo-key) (defun which-key-abort (&optional _) commit 437065886d8ac256c5539d040852c971b922a9b4 Author: Justin Burkett Date: Wed Feb 28 21:29:52 2018 -0500 Factor out which-key--this-command-keys function diff --git a/which-key.el b/which-key.el index 580cab5a7dd..e38571fbb24 100644 --- a/which-key.el +++ b/which-key.el @@ -2026,7 +2026,7 @@ including prefix arguments." (defun which-key--get-popup-map () "Generate transient-map for use in the top level binding display." - (unless (which-key--current-prefix) + (unless which-key--automatic-display (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 @@ -2485,14 +2485,12 @@ Finally, show the buffer." (message "On prefix \"%s\" which-key took %.0f ms." prefix-desc (* 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]) +(defun which-key--this-command-keys () + "Version of `this-single-command-keys' corrected for key-chords and god-mode." + (let ((this-command-keys (this-single-command-keys))) + (when (and (equal this-command-keys [key-chord]) (bound-and-true-p key-chord-mode)) - (setq prefix-keys + (setq this-command-keys (condition-case nil (let ((rkeys (recent-keys))) (vector 'key-chord @@ -2509,8 +2507,15 @@ Finally, show the buffer." (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 + (setq this-command-keys (when which-key--god-mode-key-string (kbd which-key--god-mode-key-string)))) + this-command-keys)) + +(defun which-key--update () + "Function run by timer to possibly trigger +`which-key--create-buffer-and-show'." + (let ((prefix-keys (which-key--this-command-keys)) + delay-time) (cond ((and (> (length prefix-keys) 0) (or (keymapp (key-binding prefix-keys)) ;; Some keymaps are stored here like iso-transl-ctl-x-8-map @@ -2590,7 +2595,7 @@ Finally, show the buffer." which-key--paging-functions)) (and (< 0 (length (this-single-command-keys))) (not (equal (which-key--current-prefix) - (this-single-command-keys))))) + (which-key--this-command-keys))))) (cancel-timer which-key--paging-timer) (which-key--start-timer)))))) commit 013681a1e3174071b26eedff57e2f09f6e6e7ad0 Author: Justin Burkett Date: Wed Feb 28 21:19:23 2018 -0500 Fixes related to removal of which-key--current-prefix diff --git a/which-key.el b/which-key.el index c76b6538bd9..580cab5a7dd 100644 --- a/which-key.el +++ b/which-key.el @@ -1418,9 +1418,9 @@ local bindings coming first. Within these categories order using (throw 'res res))))))) (nreverse res))) -(defun which-key--get-pseudo-binding (key-binding) +(defun which-key--get-pseudo-binding (key-binding &optional prefix) (let* ((pseudo-binding - (key-binding (which-key--pseudo-key (kbd (car key-binding)) t))) + (key-binding (which-key--pseudo-key (kbd (car key-binding)) prefix))) (pseudo-binding (when pseudo-binding (cadr pseudo-binding))) (pseudo-desc (when pseudo-binding (car pseudo-binding))) (pseudo-def (when pseudo-binding (cdr pseudo-binding))) @@ -1433,11 +1433,11 @@ local bindings coming first. Within these categories order using (eq pseudo-def real-def)) (cons (car key-binding) pseudo-desc)))) -(defun which-key--maybe-replace (key-binding) +(defun which-key--maybe-replace (key-binding &optional prefix) "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* ((pseudo-binding (which-key--get-pseudo-binding key-binding))) + (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix))) (if pseudo-binding pseudo-binding (let* ((mode-res (which-key--get-replacements key-binding t)) @@ -1487,13 +1487,13 @@ which are strings. KEY is of the form produced by `key-binding'." map (kbd (which-key--current-key-string (car keydesc)))) (intern (cdr keydesc))))) -(defun which-key--pseudo-key (key &optional use-current-prefix) +(defun which-key--pseudo-key (key &optional prefix) "Replace the last key in the sequence KEY by a special symbol in order for which-key to allow looking up a description for the key." (let* ((seq (listify-key-sequence key)) (final (intern (format "which-key-%s" (key-description (last seq)))))) - (if use-current-prefix - (vconcat (which-key--current-key-list) (list final)) + (if prefix + (vconcat prefix (list final)) (vconcat (butlast seq) (list final))))) (defun which-key--maybe-get-prefix-title (keys) @@ -1640,7 +1640,7 @@ return the docstring." (t (format "%s %s" current docstring))))) -(defun which-key--format-and-replace (unformatted &optional preserve-full-key) +(defun which-key--format-and-replace (unformatted &optional prefix preserve-full-key) "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)." @@ -1654,13 +1654,13 @@ alists. Returns a list (key separator description)." (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) + (keys (if prefix + (concat (key-description prefix) " " 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))) + (key-binding (which-key--maybe-replace (cons keys orig-desc) prefix)) (final-desc (which-key--propertize-description (cdr key-binding) group local hl-face orig-desc))) (when final-desc @@ -1810,7 +1810,7 @@ non-nil, then bindings are collected recursively for all prefixes." (when which-key-sort-order (setq unformatted (sort unformatted which-key-sort-order))) - (which-key--format-and-replace unformatted recursive))) + (which-key--format-and-replace unformatted prefix recursive))) ;;; Functions for laying out which-key buffer pages @@ -1957,7 +1957,7 @@ is the width of the live window." (setf (which-key--pages-prefix-title result) (or prefix-title (which-key--maybe-get-prefix-title - (which-key--current-key-string)))) + (key-description prefix-keys)))) result))) (defun which-key--lighter-status () @@ -2110,7 +2110,7 @@ and a page count." "Show current page. N changes the current page to the Nth page relative to the current one." (which-key--init-buffer) ;; in case it was killed - (let ((prefix-keys (key-description (which-key--current-prefix))) + (let ((prefix-keys (which-key--current-key-string)) golden-ratio-mode) (if (null which-key--pages-obj) (message "%s- which-key can't show keys: There is not \ @@ -2280,7 +2280,7 @@ 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))) + (let* ((prefix-keys (which-key--current-key-string)) (full-prefix (which-key--full-prefix prefix-keys current-prefix-arg t)) (prompt (concat (when (string-equal prefix-keys "") (which-key--propertize commit 0b2739a2bedfb117afc39e9101bdd2ec0a120897 Author: Justin Burkett Date: Wed Feb 28 11:20:20 2018 -0500 Fix display of meta bindings in which-key-show-keymap diff --git a/which-key.el b/which-key.el index a6a4c3ebc89..c76b6538bd9 100644 --- a/which-key.el +++ b/which-key.el @@ -1687,20 +1687,27 @@ ones. PREFIX is for internal use and should not be used." (lambda (ev def) (let* ((key (append prefix (list ev))) (key-desc (key-description key))) - (unless (string-match-p which-key--ignore-keys-regexp key-desc) - (if (and all (keymapp def)) + (unless (or (string-match-p which-key--ignore-keys-regexp key-desc) + (eq ev 'menu-bar)) + (if (and (keymapp def) + (or all + ;; event 27 is escape, so this will pick up meta + ;; bindings and hopefully not too much more + (and (numberp ev) (= ev 27)))) (setq bindings (append bindings (which-key--get-keymap-bindings def t key))) - (cl-pushnew - (cons key-desc - (cond - ((keymapp def) "Prefix Command") - ((symbolp def) (copy-sequence (symbol-name def))) - ((eq 'lambda (car-safe def)) "lambda") - ((eq 'menu-item (car-safe def)) "menu-item") - (t (format "%s" def)))) - bindings :test (lambda (a b) (string= (car a) (car b)))))))) + (when def + (cl-pushnew + (cons key-desc + (cond + ((keymapp def) "Prefix Command") + ((symbolp def) (copy-sequence (symbol-name def))) + ((eq 'lambda (car-safe def)) "lambda") + ((eq 'menu-item (car-safe def)) "menu-item") + ((stringp def) def) + (t "unknown"))) + bindings :test (lambda (a b) (string= (car a) (car b))))))))) keymap) bindings)) commit 3c05294dc6b9ad97183cb53cf584e273f1eacdb6 Author: Justin Burkett Date: Wed Feb 28 08:03:16 2018 -0500 Fix which-key--create-pages diff --git a/which-key.el b/which-key.el index ba6bc454c1a..a6a4c3ebc89 100644 --- a/which-key.el +++ b/which-key.el @@ -1944,7 +1944,8 @@ is the width of the live window." (setq result (which-key--create-pages-1 keys avl-lines avl-width min-lines vertical)) - (when (> (which-key--pages-num-pages result) 0) + (when (and result + (> (which-key--pages-num-pages result) 0)) (setf (which-key--pages-prefix result) prefix-keys) (setf (which-key--pages-prefix-title result) (or prefix-title commit ded908ec0b95f8890e11a8ef3a700c583a0ca036 Author: Justin Burkett Date: Wed Feb 28 07:57:44 2018 -0500 Remove which-key--current-prefix diff --git a/which-key.el b/which-key.el index 2abb5296b6d..ba6bc454c1a 100644 --- a/which-key.el +++ b/which-key.el @@ -634,8 +634,6 @@ Used when `which-key-popup-type' is frame.") "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--current-prefix nil - "Internal: Holds current prefix") (defvar which-key--last-try-2-loc nil "Internal: Last location of side-window when two locations used.") @@ -693,6 +691,10 @@ update.") (= (which-key--pages-page-nums which-key--pages-obj) (which-key--pages-num-pages which-key--pages-obj))) +(defsubst which-key--current-prefix () + (when which-key--pages-obj + (which-key--pages-prefix which-key--pages-obj))) + ;;; Third-party library support ;;;; Evil @@ -1061,9 +1063,10 @@ total height." (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-prefix nil - which-key--automatic-display nil - which-key--prior-show-keymap-args nil) + (setq which-key--last-try-2-loc nil) + (setq which-key--pages-obj nil) + (setq which-key--automatic-display nil) + (setq which-key--prior-show-keymap-args nil) (when (and which-key-idle-secondary-delay which-key--secondary-timer-active) (which-key--start-timer)) @@ -1460,7 +1463,7 @@ which are strings. KEY is of the form produced by `key-binding'." (t (cdr key-binding)))))))))))) (defsubst which-key--current-key-list (&optional key-str) - (append (listify-key-sequence which-key--current-prefix) + (append (listify-key-sequence (which-key--current-prefix)) (when key-str (listify-key-sequence (kbd key-str))))) @@ -1651,7 +1654,7 @@ alists. Returns a list (key separator description)." (orig-desc (cdr key-binding)) (group (which-key--group-p orig-desc)) ;; At top-level prefix is nil - (keys (if which-key--current-prefix + (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)) @@ -1919,7 +1922,7 @@ should be minimized." found (> (which-key--pages-num-pages result) 1))) (if found prev-result result)))) -(defun which-key--create-pages (keys &optional prefix-title) +(defun which-key--create-pages (keys &optional prefix-keys prefix-title) "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 @@ -1927,8 +1930,8 @@ 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-desc (key-description prefix-keys)) + (full-prefix (which-key--full-prefix prefix-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))) @@ -1939,8 +1942,10 @@ is the width of the live window." (member which-key-side-window-location '(left right)))) result) (setq result - (which-key--create-pages-1 keys avl-lines avl-width min-lines vertical)) + (which-key--create-pages-1 + keys avl-lines avl-width min-lines vertical)) (when (> (which-key--pages-num-pages result) 0) + (setf (which-key--pages-prefix result) prefix-keys) (setf (which-key--pages-prefix-title result) (or prefix-title (which-key--maybe-get-prefix-title @@ -2004,7 +2009,7 @@ including prefix arguments." (which-key--universal-argument--description) (when prefix-arg " ") prefix-keys)) - (dash (if (and which-key--current-prefix + (dash (if (and (not (string= prefix-keys "")) (null left)) "-" ""))) (if (or (eq which-key-show-prefix 'echo) dont-prop-keys) (concat str dash) @@ -2013,7 +2018,7 @@ including prefix arguments." (defun which-key--get-popup-map () "Generate transient-map for use in the top level binding display." - (unless which-key--current-prefix + (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 @@ -2029,10 +2034,10 @@ and a page count." (height (which-key--pages-height pages-obj)) (n-pages (which-key--pages-num-pages pages-obj)) (page-n (car (which-key--pages-page-nums pages-obj))) - (prefix-keys (key-description which-key--current-prefix)) + (prefix-desc (key-description (which-key--pages-prefix pages-obj))) (prefix-title (which-key--pages-prefix-title pages-obj)) - (full-prefix (which-key--full-prefix prefix-keys)) - (nxt-pg-hint (which-key--next-page-hint prefix-keys)) + (full-prefix (which-key--full-prefix prefix-desc)) + (nxt-pg-hint (which-key--next-page-hint prefix-desc)) ;; not used in left case (status-line (concat (which-key--propertize prefix-title 'face 'which-key-note-face) @@ -2080,7 +2085,7 @@ and a page count." (cons page (lambda () (which-key--echo - (concat full-prefix (when prefix-keys " ") + (concat full-prefix (when prefix-desc " ") status-line (when status-line " ") nxt-pg-hint))))) (`mode-line @@ -2097,7 +2102,7 @@ and a page count." "Show current page. N changes the current page to the Nth page relative to the current one." (which-key--init-buffer) ;; in case it was killed - (let ((prefix-keys (key-description which-key--current-prefix)) + (let ((prefix-keys (key-description (which-key--current-prefix))) golden-ratio-mode) (if (null which-key--pages-obj) (message "%s- which-key can't show keys: There is not \ @@ -2257,7 +2262,7 @@ current evil state. " (unless (eq which-key-show-docstrings 'docstring-only) (setq which-key-show-docstrings (null which-key-show-docstrings))) (which-key-reload-key-sequence) - (which-key--create-buffer-and-show which-key--current-prefix)) + (which-key--create-buffer-and-show (which-key--current-prefix))) ;;;###autoload (defun which-key-C-h-dispatch () @@ -2267,7 +2272,7 @@ 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)) + (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 "") (which-key--propertize @@ -2310,14 +2315,15 @@ prefix) if `which-key-use-C-h-commands' is non nil." (throw 'match t))))) (defun which-key--try-2-side-windows - (keys prefix-title loc1 loc2 &rest _ignore) - "Try to show KEYS (PAGE-N) in LOC1 first. + (bindings prefix-keys prefix-title loc1 loc2 &rest _ignore) + "Try to show BINDINGS (PAGE-N) in LOC1 first. -Only if no keys fit fallback to LOC2." +Only if no bindings 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 prefix-title))) + (setq pages1 (which-key--create-pages + bindings prefix-keys prefix-title))) (if pages1 (progn (setq which-key--pages-obj pages1) @@ -2328,7 +2334,7 @@ Only if no keys fit fallback to LOC2." (let ((which-key-side-window-location loc2) (which-key--multiple-locations t)) (setq which-key--pages-obj - (which-key--create-pages keys prefix-title)) + (which-key--create-pages bindings prefix-keys prefix-title)) (which-key--show-page) loc2)))) @@ -2385,7 +2391,6 @@ is selected interactively by mode in `minor-mode-map-alist'." (cdr (assq mode-sym minor-mode-map-alist))))) (defun which-key--show-keymap (keymap-name keymap &optional prior-args all) - (setq which-key--current-prefix nil) (when prior-args (push prior-args which-key--prior-show-keymap-args)) (let ((bindings (which-key--get-bindings nil keymap nil all))) (if (= (length bindings) 0) @@ -2393,9 +2398,10 @@ is selected interactively by mode in `minor-mode-map-alist'." (cond ((listp which-key-side-window-location) (setq which-key--last-try-2-loc (apply #'which-key--try-2-side-windows - bindings keymap-name which-key-side-window-location))) + bindings nil keymap-name + which-key-side-window-location))) (t (setq which-key--pages-obj - (which-key--create-pages bindings keymap-name)) + (which-key--create-pages bindings nil keymap-name)) (which-key--show-page))) (let* ((key (key-description (list (read-key)))) (next-def (lookup-key keymap (kbd key)))) @@ -2419,7 +2425,6 @@ is selected interactively by mode in `minor-mode-map-alist'." (make-composed-keymap (list evil-operator-shortcut-map evil-operator-state-map evil-motion-state-map)))) - (setq which-key--current-prefix nil) (when (keymapp keymap) (let ((formatted-keys (which-key--get-bindings @@ -2429,10 +2434,12 @@ is selected interactively by mode in `minor-mode-map-alist'." ((listp which-key-side-window-location) (setq which-key--last-try-2-loc (apply #'which-key--try-2-side-windows - formatted-keys "evil operator/motion keys" + formatted-keys nil "evil operator/motion keys" which-key-side-window-location))) (t (setq which-key--pages-obj - (which-key--create-pages formatted-keys)) + (which-key--create-pages + formatted-keys + nil "evil operator/motion keys")) (which-key--show-page))))) (let* ((key (key-description (list (read-key))))) (when (string= key "`") @@ -2451,24 +2458,23 @@ is selected interactively by mode in `minor-mode-map-alist'." (&optional prefix-keys from-keymap filter prefix-title) "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-bindings prefix-keys from-keymap filter)) - (prefix-keys (key-description which-key--current-prefix))) + (prefix-desc (key-description prefix-keys))) (cond ((= (length formatted-keys) 0) - (message "%s- which-key: There are no keys to show" prefix-keys)) + (message "%s- which-key: There are no keys to show" prefix-desc)) ((listp which-key-side-window-location) (setq which-key--last-try-2-loc (apply #'which-key--try-2-side-windows - formatted-keys prefix-title + formatted-keys prefix-keys prefix-title which-key-side-window-location))) (t (setq which-key--pages-obj - (which-key--create-pages formatted-keys prefix-title)) + (which-key--create-pages + formatted-keys prefix-keys prefix-title)) (which-key--show-page))) (when which-key--debug - (message "On prefix \"%s\" which-key took %.0f ms." prefix-keys + (message "On prefix \"%s\" which-key took %.0f ms." prefix-desc (* 1000 (float-time (time-since start-time))))))) (defun which-key--update () @@ -2521,7 +2527,7 @@ Finally, show the buffer." (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)) + (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 @@ -2575,7 +2581,7 @@ Finally, show the buffer." (when (or (not (member real-last-command which-key--paging-functions)) (and (< 0 (length (this-single-command-keys))) - (not (equal which-key--current-prefix + (not (equal (which-key--current-prefix) (this-single-command-keys))))) (cancel-timer which-key--paging-timer) (which-key--start-timer)))))) commit e97253b0523121f15e1a7965e7f4b792e25e2b6c Author: Justin Burkett Date: Tue Feb 27 21:05:58 2018 -0500 Add prefix arg to which-key--get-current-bindings and .. which-key--get-bindings diff --git a/which-key.el b/which-key.el index 4911c4c0cc5..2abb5296b6d 100644 --- a/which-key.el +++ b/which-key.el @@ -1711,9 +1711,9 @@ Requires `which-key-compute-remaps' to be non-nil" (copy-sequence (symbol-name remap)) binding))) -(defun which-key--get-current-bindings () +(defun which-key--get-current-bindings (&optional prefix) "Generate a list of current active bindings." - (let ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) + (let ((key-str-qt (regexp-quote (key-description prefix))) (buffer (current-buffer)) (ignore-bindings '("self-insert-command" "ignore" "ignore-event" "company-ignore")) @@ -1724,7 +1724,7 @@ Requires `which-key-compute-remaps' to be non-nil" (with-temp-buffer (setq-local indent-tabs-mode t) (setq-local tab-width 8) - (describe-buffer-bindings buffer which-key--current-prefix) + (describe-buffer-bindings buffer prefix) (goto-char (point-min)) (let ((header-p (not (= (char-after) ?\f))) bindings header) @@ -1739,8 +1739,7 @@ Requires `which-key-compute-remaps' to be non-nil" ((= (char-after) ?\f) (setq header-p t)) ((looking-at "^[ \t]*$")) - ((or (not (string-match-p ignore-sections-regexp header)) - which-key--current-prefix) + ((or (not (string-match-p ignore-sections-regexp header)) prefix) (let ((binding-start (save-excursion (and (re-search-forward "\t+" nil t) (match-end 0)))) @@ -1755,14 +1754,14 @@ Requires `which-key-compute-remaps' to be non-nil" (cond ((member binding ignore-bindings)) ((string-match-p which-key--ignore-keys-regexp key)) - ((and which-key--current-prefix + ((and 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 + ((and prefix (string-match (format "^%s[ \t]\\([^ \t]+\\) \\.\\. %s[ \t]\\([^ \t]+\\)[ \t]+$" @@ -1783,7 +1782,7 @@ Requires `which-key-compute-remaps' to be non-nil" (forward-line)) (nreverse bindings))))) -(defun which-key--get-bindings (&optional keymap filter recursive) +(defun which-key--get-bindings (&optional prefix keymap filter recursive) "Collect key bindings. If KEYMAP is nil, collect from current buffer using the current key sequence as a prefix. Otherwise, collect from KEYMAP. FILTER @@ -1795,7 +1794,7 @@ non-nil, then bindings are collected recursively for all prefixes." (keymap (error "%s is not a keymap" keymap)) (t - (which-key--get-current-bindings))))) + (which-key--get-current-bindings prefix))))) (when filter (setq unformatted (cl-remove-if-not filter unformatted))) (when which-key-sort-order @@ -2388,7 +2387,7 @@ is selected interactively by mode in `minor-mode-map-alist'." (defun which-key--show-keymap (keymap-name keymap &optional prior-args all) (setq which-key--current-prefix nil) (when prior-args (push prior-args which-key--prior-show-keymap-args)) - (let ((bindings (which-key--get-bindings keymap nil all))) + (let ((bindings (which-key--get-bindings nil keymap nil all))) (if (= (length bindings) 0) (message "which-key: No bindings found in %s" keymap-name) (cond ((listp which-key-side-window-location) @@ -2423,7 +2422,8 @@ is selected interactively by mode in `minor-mode-map-alist'." (setq which-key--current-prefix nil) (when (keymapp keymap) (let ((formatted-keys - (which-key--get-bindings keymap #'which-key--evil-operator-filter))) + (which-key--get-bindings + nil keymap #'which-key--evil-operator-filter))) (cond ((= (length formatted-keys) 0) (message "which-key: Keymap empty")) ((listp which-key-side-window-location) @@ -2454,7 +2454,8 @@ 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-bindings from-keymap filter)) + (formatted-keys (which-key--get-bindings + prefix-keys from-keymap filter)) (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)) commit ed7aa66aadfe23cd318a656d0898a0441f8b395b Author: Justin Burkett Date: Tue Feb 27 20:32:19 2018 -0500 Remove a bunch of global variables Remove need for which-key--using-top-level. Add prefix-title slot to which-key--pages object. Remove which-key--using-show-keymap. Remove which-key--current-show-keymap-name. Remove which-key--using-show-operator-keymap. diff --git a/which-key.el b/which-key.el index 038c4686aad..4911c4c0cc5 100644 --- a/which-key.el +++ b/which-key.el @@ -643,11 +643,7 @@ used.") "Internal: Non-nil if popup was triggered with automatic update.") (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) @@ -669,7 +665,9 @@ update.") keys/page page-nums num-pages - total-keys) + total-keys + prefix + prefix-title) (defun which-key--rotate (list n) (let* ((len (length list)) @@ -1065,12 +1063,7 @@ total height." (unless (member real-this-command which-key--paging-functions) (setq which-key--current-prefix nil which-key--automatic-display 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) + which-key--prior-show-keymap-args nil) (when (and which-key-idle-secondary-delay which-key--secondary-timer-active) (which-key--start-timer)) @@ -1524,10 +1517,7 @@ no title exists." (if alternate alternate (concat "Following " keys))) (t "")))) - (which-key--using-top-level which-key--using-top-level) - (which-key--current-show-keymap-name - which-key--current-show-keymap-name) - (t ""))) + (t ""))) (defun which-key--propertize (string &rest properties) "Version of `propertize' that checks type of STRING." @@ -1930,7 +1920,7 @@ should be minimized." found (> (which-key--pages-num-pages result) 1))) (if found prev-result result)))) -(defun which-key--create-pages (keys) +(defun which-key--create-pages (keys &optional prefix-title) "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 @@ -1952,6 +1942,10 @@ is the width of the live window." (setq result (which-key--create-pages-1 keys avl-lines avl-width min-lines vertical)) (when (> (which-key--pages-num-pages result) 0) + (setf (which-key--pages-prefix-title result) + (or prefix-title + (which-key--maybe-get-prefix-title + (which-key--current-key-string)))) result))) (defun which-key--lighter-status () @@ -1979,10 +1973,7 @@ is the width of the live window." (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))))) + (when which-key-use-C-h-commands (which-key--propertize (format "[%s paging/help]" key) 'face 'which-key-note-face)))) @@ -2040,13 +2031,12 @@ and a page count." (n-pages (which-key--pages-num-pages pages-obj)) (page-n (car (which-key--pages-page-nums pages-obj))) (prefix-keys (key-description which-key--current-prefix)) + (prefix-title (which-key--pages-prefix-title pages-obj)) (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 (which-key--propertize (which-key--maybe-get-prefix-title - (which-key--current-key-string)) - 'face 'which-key-note-face) + (concat (which-key--propertize prefix-title 'face 'which-key-note-face) (when (< 1 n-pages) (which-key--propertize (format " (%s of %s)" page-n n-pages) 'face 'which-key-note-face))))) @@ -2212,8 +2202,7 @@ after first page." (defun which-key-show-top-level (&optional _) "Show top-level bindings." (interactive) - (setq which-key--using-top-level "Top-level bindings") - (which-key--create-buffer-and-show nil)) + (which-key--create-buffer-and-show nil nil nil "Top-level bindings")) ;;;###autoload (defun which-key-show-major-mode () @@ -2223,11 +2212,12 @@ This function will also detect evil bindings made using `evil-define-key' in this map. These bindings will depend on the current evil state. " (interactive) - (setq which-key--using-top-level "Major-mode bindings") (let ((map-sym (intern (format "%s-map" major-mode)))) (if (and (boundp map-sym) (keymapp (symbol-value map-sym))) (which-key--create-buffer-and-show - nil nil (apply-partially #'which-key--map-binding-p (symbol-value map-sym))) + nil nil + (apply-partially #'which-key--map-binding-p (symbol-value map-sym)) + "Major-mode bindings") (message "which-key: No map named %s" map-sym)))) ;;;###autoload @@ -2236,7 +2226,7 @@ current evil state. " (interactive) (let* ((key-lst (butlast (which-key--current-key-list))) (which-key-inhibit t)) - (cond ((stringp which-key--current-show-keymap-name) + (cond (which-key--prior-show-keymap-args (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))) @@ -2283,8 +2273,8 @@ prefix) if `which-key-use-C-h-commands' is non nil." (prompt (concat (when (string-equal prefix-keys "") (which-key--propertize (concat " " - (or which-key--current-show-keymap-name - "Top-level bindings")) + (which-key--pages-prefix-title + which-key--pages-obj)) 'face 'which-key-note-face)) full-prefix (which-key--propertize @@ -2320,14 +2310,15 @@ prefix) if `which-key-use-C-h-commands' is non nil." (when (string-match-p regexp string) (throw 'match t))))) -(defun which-key--try-2-side-windows (keys loc1 loc2 &rest _ignore) +(defun which-key--try-2-side-windows + (keys prefix-title 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))) + (setq pages1 (which-key--create-pages keys prefix-title))) (if pages1 (progn (setq which-key--pages-obj pages1) @@ -2338,7 +2329,7 @@ Only if no keys fit fallback to LOC2." (let ((which-key-side-window-location loc2) (which-key--multiple-locations t)) (setq which-key--pages-obj - (which-key--create-pages keys)) + (which-key--create-pages keys prefix-title)) (which-key--show-page) loc2)))) @@ -2395,9 +2386,7 @@ is selected interactively by mode in `minor-mode-map-alist'." (cdr (assq mode-sym minor-mode-map-alist))))) (defun which-key--show-keymap (keymap-name keymap &optional prior-args all) - (setq which-key--current-prefix nil - which-key--current-show-keymap-name keymap-name - which-key--using-show-keymap t) + (setq which-key--current-prefix nil) (when prior-args (push prior-args which-key--prior-show-keymap-args)) (let ((bindings (which-key--get-bindings keymap nil all))) (if (= (length bindings) 0) @@ -2405,9 +2394,9 @@ is selected interactively by mode in `minor-mode-map-alist'." (cond ((listp which-key-side-window-location) (setq which-key--last-try-2-loc (apply #'which-key--try-2-side-windows - bindings which-key-side-window-location))) + bindings keymap-name which-key-side-window-location))) (t (setq which-key--pages-obj - (which-key--create-pages bindings)) + (which-key--create-pages bindings keymap-name)) (which-key--show-page))) (let* ((key (key-description (list (read-key)))) (next-def (lookup-key keymap (kbd key)))) @@ -2431,9 +2420,7 @@ is selected interactively by mode in `minor-mode-map-alist'." (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) + (setq which-key--current-prefix nil) (when (keymapp keymap) (let ((formatted-keys (which-key--get-bindings keymap #'which-key--evil-operator-filter))) @@ -2442,7 +2429,8 @@ is selected interactively by mode in `minor-mode-map-alist'." ((listp which-key-side-window-location) (setq which-key--last-try-2-loc (apply #'which-key--try-2-side-windows - formatted-keys which-key-side-window-location))) + formatted-keys "evil operator/motion keys" + which-key-side-window-location))) (t (setq which-key--pages-obj (which-key--create-pages formatted-keys)) (which-key--show-page))))) @@ -2459,7 +2447,8 @@ is selected interactively by mode in `minor-mode-map-alist'." (which-key--hide-popup) (setq unread-command-events (listify-key-sequence key)))))))) -(defun which-key--create-buffer-and-show (&optional prefix-keys from-keymap filter) +(defun which-key--create-buffer-and-show + (&optional prefix-keys from-keymap filter prefix-title) "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." (setq which-key--current-prefix prefix-keys @@ -2472,9 +2461,10 @@ Finally, show the buffer." ((listp which-key-side-window-location) (setq which-key--last-try-2-loc (apply #'which-key--try-2-side-windows - formatted-keys which-key-side-window-location))) + formatted-keys prefix-title + which-key-side-window-location))) (t (setq which-key--pages-obj - (which-key--create-pages formatted-keys)) + (which-key--create-pages formatted-keys prefix-title)) (which-key--show-page))) (when which-key--debug (message "On prefix \"%s\" which-key took %.0f ms." prefix-keys @@ -2553,7 +2543,7 @@ Finally, show the buffer." ((and which-key-show-operator-state-maps (bound-and-true-p evil-state) (eq evil-state 'operator) - (not which-key--using-show-operator-keymap)) + (not (which-key--popup-showing-p))) (which-key--show-evil-operator-keymap)) (which-key--automatic-display (which-key--hide-popup))))) commit 61e399f75f7ea90f9dfbd1407730e685b7e3f17d Author: Justin Burkett Date: Tue Feb 27 20:30:07 2018 -0500 Add and use which-key--automatic-display diff --git a/which-key.el b/which-key.el index ca1aa25e9a8..038c4686aad 100644 --- a/which-key.el +++ b/which-key.el @@ -639,6 +639,9 @@ Used when `which-key-popup-type' is frame.") (defvar which-key--last-try-2-loc nil "Internal: Last location of side-window when two locations used.") +(defvar which-key--automatic-display nil + "Internal: Non-nil if popup was triggered with automatic +update.") (defvar which-key--multiple-locations nil) (defvar which-key--using-top-level nil) (defvar which-key--using-show-keymap nil) @@ -1061,6 +1064,7 @@ total height." "This function is called to hide the which-key buffer." (unless (member real-this-command which-key--paging-functions) (setq which-key--current-prefix nil + which-key--automatic-display nil which-key--using-top-level nil which-key--using-show-keymap nil which-key--using-show-operator-keymap nil @@ -2534,6 +2538,7 @@ Finally, show the buffer." (key-description prefix-keys) (length prefix-keys)))) (sit-for delay-time))) + (setq which-key--automatic-display t) (which-key--create-buffer-and-show prefix-keys) (when (and which-key-idle-secondary-delay (not which-key--secondary-timer-active)) @@ -2550,9 +2555,7 @@ Finally, show the buffer." (eq evil-state 'operator) (not which-key--using-show-operator-keymap)) (which-key--show-evil-operator-keymap)) - ((and (not which-key--using-top-level) - (not which-key--using-show-operator-keymap) - (not which-key--using-show-keymap)) + (which-key--automatic-display (which-key--hide-popup))))) ;;; Timers commit ab6039187314fccf0f5c22d51684f21a394b1f63 Author: Justin Burkett Date: Tue Feb 27 09:04:39 2018 -0500 Use cl-struct to hold which-key pages diff --git a/which-key.el b/which-key.el index 82e747a2ed5..ca1aa25e9a8 100644 --- a/which-key.el +++ b/which-key.el @@ -634,15 +634,8 @@ Used when `which-key-popup-type' is frame.") "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.") @@ -665,6 +658,40 @@ used.") (make-obsolete-variable 'which-key-prefix-name-alist nil "2016-10-05") (make-obsolete-variable 'which-key-prefix-title-alist nil "2016-10-05") +(defvar which-key--pages-obj nil) +(cl-defstruct which-key--pages + pages + height + widths + keys/page + page-nums + num-pages + total-keys) + +(defun which-key--rotate (list n) + (let* ((len (length list)) + (n (if (< n 0) (+ len n) n)) + (n (mod n len))) + (append (last list (- len n)) (butlast list (- len n))))) + +(defun which-key--pages-set-current-page (pages-obj n) + (setf (which-key--pages-pages pages-obj) + (which-key--rotate (which-key--pages-pages pages-obj) n)) + (setf (which-key--pages-widths pages-obj) + (which-key--rotate (which-key--pages-widths pages-obj) n)) + (setf (which-key--pages-keys/page pages-obj) + (which-key--rotate (which-key--pages-keys/page pages-obj) n)) + (setf (which-key--pages-page-nums pages-obj) + (which-key--rotate (which-key--pages-page-nums pages-obj) n)) + pages-obj) + +(defsubst which-key--on-first-page () + (= (which-key--pages-page-nums which-key--pages-obj) 1)) + +(defsubst which-key--on-last-page () + (= (which-key--pages-page-nums which-key--pages-obj) + (which-key--pages-num-pages which-key--pages-obj))) + ;;; Third-party library support ;;;; Evil @@ -1033,8 +1060,7 @@ total height." (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 + (setq which-key--current-prefix nil which-key--using-top-level nil which-key--using-show-keymap nil which-key--using-show-operator-keymap nil @@ -1835,16 +1861,15 @@ that width." (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." +Returns a `which-key--pages' object 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) + nil (while cols-w-widths ;; start new page (cl-incf n-pages) @@ -1866,10 +1891,14 @@ metadata." (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))))) + (make-which-key--pages + :pages (nreverse pages) + :height avl-lines + :widths (nreverse page-widths) + :keys/page (reverse keys/page) + :page-nums (number-sequence 1 n-pages) + :num-pages n-pages + :total-keys (apply #'+ keys/page))))) (defun which-key--create-pages-1 (keys available-lines available-width &optional min-lines vertical) @@ -1882,8 +1911,9 @@ should be minimized." keys available-lines available-width)) (min-lines (or min-lines 0)) found prev-result) - (if (or vertical - (> (plist-get result :n-pages) 1) + (if (or (null result) + vertical + (> (which-key--pages-num-pages result) 1) (= 1 available-lines)) result ;; simple search for a fitting page @@ -1893,7 +1923,7 @@ should be minimized." prev-result result result (which-key--list-to-pages keys available-lines available-width) - found (> (plist-get result :n-pages) 1))) + found (> (which-key--pages-num-pages result) 1))) (if found prev-result result)))) (defun which-key--create-pages (keys) @@ -1913,14 +1943,18 @@ is the width of the live window." (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) + (member which-key-side-window-location '(left right)))) + result) + (setq result + (which-key--create-pages-1 keys avl-lines avl-width min-lines vertical)) + (when (> (which-key--pages-num-pages result) 0) + result))) + +(defun which-key--lighter-status () "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))) + (let ((n-shown (car (which-key--pages-keys/page which-key--pages-obj))) + (n-tot (which-key--pages-total-keys which-key--pages-obj))) (setcar (cdr (assq 'which-key-mode minor-mode-alist)) (format " WK: %s/%s keys" n-shown n-tot))))) @@ -1993,13 +2027,14 @@ including prefix arguments." (define-key map (kbd "C-h") #'which-key-C-h-dispatch)) map))) -(defun which-key--process-page (page-n pages-plist) +(defun which-key--process-page (pages-obj) "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)) + (let* ((page (car (which-key--pages-pages pages-obj))) + (height (which-key--pages-height pages-obj)) + (n-pages (which-key--pages-num-pages pages-obj)) + (page-n (car (which-key--pages-page-nums pages-obj))) (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)) @@ -2009,12 +2044,11 @@ and a page count." (which-key--current-key-string)) 'face 'which-key-note-face) (when (< 1 n-pages) - (which-key--propertize (format " (%s of %s)" - (1+ page-n) n-pages) + (which-key--propertize (format " (%s of %s)" page-n n-pages) 'face 'which-key-note-face))))) (pcase which-key-show-prefix (`left - (let* ((page-cnt (which-key--propertize (format "%s/%s" (1+ page-n) n-pages) + (let* ((page-cnt (which-key--propertize (format "%s/%s" 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)))) @@ -2066,23 +2100,22 @@ and a page count." " " nxt-pg-hint)))))) (_ (cons page nil))))) -(defun which-key--show-page (n) - "Show page N, starting from 0." +(defun which-key--show-page (&optional n) + "Show current page. N changes the current page to the Nth page +relative to the current one." (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) + (let ((prefix-keys (key-description which-key--current-prefix)) + golden-ratio-mode) + (if (null which-key--pages-obj) (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) + (when n + (setq which-key--pages-obj + (which-key--pages-set-current-page which-key--pages-obj n))) + (let ((page-echo (which-key--process-page which-key--pages-obj)) + (height (which-key--pages-height which-key--pages-obj)) + (width (car (which-key--pages-widths which-key--pages-obj)))) + (which-key--lighter-status) (if (eq which-key-popup-type 'minibuffer) (which-key--echo (car page-echo)) (with-current-buffer which-key--buffer @@ -2113,15 +2146,13 @@ used are reapplied to the new key sequence." (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) - (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))) + (which-key-reload-key-sequence) + (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 delta)) + (which-key--show-page delta)) + (which-key--start-paging-timer)) ;;;###autoload (defun which-key-show-standard-help (&optional _) @@ -2144,8 +2175,7 @@ Usually this is `describe-prefix-bindings'." call `which-key-show-standard-help'." (interactive) (let ((which-key-inhibit t)) - (if (and which-key--current-page-n - which-key--on-last-page) + (if (which-key--on-last-page) (which-key-show-standard-help) (which-key-turn-page 1)))) @@ -2155,9 +2185,7 @@ call `which-key-show-standard-help'." 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) + (unless (which-key--on-first-page) (which-key-turn-page -1)))) ;;;###autoload @@ -2288,7 +2316,7 @@ prefix) if `which-key-use-C-h-commands' is non nil." (when (string-match-p regexp string) (throw 'match t))))) -(defun which-key--try-2-side-windows (keys page-n loc1 loc2 &rest _ignore) +(defun which-key--try-2-side-windows (keys loc1 loc2 &rest _ignore) "Try to show KEYS (PAGE-N) in LOC1 first. Only if no keys fit fallback to LOC2." @@ -2296,18 +2324,18 @@ Only if no keys fit fallback to LOC2." (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)) + (if pages1 (progn - (setq which-key--pages-plist pages1) + (setq which-key--pages-obj pages1) (let ((which-key-side-window-location loc1) (which-key--multiple-locations t)) - (which-key--show-page page-n)) + (which-key--show-page)) loc1) (let ((which-key-side-window-location loc2) (which-key--multiple-locations t)) - (setq which-key--pages-plist + (setq which-key--pages-obj (which-key--create-pages keys)) - (which-key--show-page page-n) + (which-key--show-page) loc2)))) (defun which-key--read-keymap () @@ -2373,10 +2401,10 @@ is selected interactively by mode in `minor-mode-map-alist'." (cond ((listp which-key-side-window-location) (setq which-key--last-try-2-loc (apply #'which-key--try-2-side-windows - bindings 0 which-key-side-window-location))) - (t (setq which-key--pages-plist + bindings which-key-side-window-location))) + (t (setq which-key--pages-obj (which-key--create-pages bindings)) - (which-key--show-page 0))) + (which-key--show-page))) (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)) @@ -2410,10 +2438,10 @@ is selected interactively by mode in `minor-mode-map-alist'." ((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 + formatted-keys which-key-side-window-location))) + (t (setq which-key--pages-obj (which-key--create-pages formatted-keys)) - (which-key--show-page 0))))) + (which-key--show-page))))) (let* ((key (key-description (list (read-key))))) (when (string= key "`") ;; evil-goto-mark reads the next char manually @@ -2440,10 +2468,10 @@ Finally, show the buffer." ((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 + formatted-keys which-key-side-window-location))) + (t (setq which-key--pages-obj (which-key--create-pages formatted-keys)) - (which-key--show-page 0))) + (which-key--show-page))) (when which-key--debug (message "On prefix \"%s\" which-key took %.0f ms." prefix-keys (* 1000 (float-time (time-since start-time))))))) @@ -2522,8 +2550,7 @@ Finally, show the buffer." (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) + ((and (not which-key--using-top-level) (not which-key--using-show-operator-keymap) (not which-key--using-show-keymap)) (which-key--hide-popup))))) @@ -2556,8 +2583,6 @@ Finally, show the buffer." (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)))))) commit 9dc8d3233b6a4d8079c8a8a4b24f61ac146aa694 Author: Justin Burkett Date: Mon Feb 26 13:24:41 2018 -0500 Add which-key-toggle-docstrings diff --git a/which-key.el b/which-key.el index 2158dd929f5..82e747a2ed5 100644 --- a/which-key.el +++ b/which-key.el @@ -418,6 +418,8 @@ prefixes in `which-key-paging-prefixes'" (let ((map (make-sparse-keymap))) (dolist (bind '(("\C-a" . which-key-abort) ("a" . which-key-abort) + ("\C-d" . which-key-toggle-docstrings) + ("d" . which-key-toggle-docstrings) ("\C-h" . which-key-show-standard-help) ("h" . which-key-show-standard-help) ("\C-n" . which-key-show-next-page-cycle) @@ -2228,6 +2230,14 @@ current evil state. " (let ((current-prefix-arg prefix-arg)) (which-key-reload-key-sequence))) +(defun which-key-toggle-docstrings (&optional _) + "Toggle the display of docstrings." + (interactive) + (unless (eq which-key-show-docstrings 'docstring-only) + (setq which-key-show-docstrings (null which-key-show-docstrings))) + (which-key-reload-key-sequence) + (which-key--create-buffer-and-show which-key--current-prefix)) + ;;;###autoload (defun which-key-C-h-dispatch () "Dispatch C-h commands by looking up key in @@ -2255,6 +2265,8 @@ prefix) if `which-key-use-C-h-commands' is non nil." which-key-separator "previous-page," " \\[which-key-undo-key]" which-key-separator "undo-key," + " \\[which-key-toggle-docstrings]" + which-key-separator "toggle-docstrings," " \\[which-key-show-standard-help]" which-key-separator "help," " \\[which-key-abort]" commit f77d4210f6215fedd25cebaddaca16c12cc9d0d1 Author: Justin Burkett Date: Mon Feb 26 13:21:17 2018 -0500 Consolidate key binding collection into which-key--get-bindings diff --git a/which-key.el b/which-key.el index 96e71907705..2158dd929f5 100644 --- a/which-key.el +++ b/which-key.el @@ -1761,16 +1761,25 @@ Requires `which-key-compute-remaps' to be non-nil" (forward-line)) (nreverse bindings))))) -(defun which-key--get-formatted-key-bindings (&optional bindings filter preserve-full-key) - "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)))) +(defun which-key--get-bindings (&optional keymap filter recursive) + "Collect key bindings. +If KEYMAP is nil, collect from current buffer using the current +key sequence as a prefix. Otherwise, collect from KEYMAP. FILTER +is a function to use to filter the bindings. If RECURSIVE is +non-nil, then bindings are collected recursively for all prefixes." + (let* ((unformatted + (cond ((keymapp keymap) + (which-key--get-keymap-bindings keymap recursive)) + (keymap + (error "%s is not a keymap" keymap)) + (t + (which-key--get-current-bindings))))) (when filter (setq unformatted (cl-remove-if-not filter unformatted))) (when which-key-sort-order (setq unformatted (sort unformatted which-key-sort-order))) - (which-key--format-and-replace unformatted preserve-full-key))) + (which-key--format-and-replace unformatted recursive))) ;;; Functions for laying out which-key buffer pages @@ -2342,37 +2351,29 @@ is selected interactively by mode in `minor-mode-map-alist'." (cdr (assq mode-sym minor-mode-map-alist))))) (defun which-key--show-keymap (keymap-name keymap &optional prior-args all) - (let (unformatted-keys formatted-keys) - (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)) - (if (and (keymapp keymap) - (setq unformatted-keys (which-key--get-keymap-bindings keymap all)) - ;; need this in two steps otherwise - ;; `which-key--get-formatted-key-bindings' will look for global - ;; keys if second argument is nil - (setq formatted-keys (which-key--get-formatted-key-bindings - unformatted-keys nil all)) - (> (length formatted-keys) 0)) - (progn - (cond ((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))))) - (message "which-key: No bindings found in %s" keymap-name)))) + (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)) + (let ((bindings (which-key--get-bindings keymap nil all))) + (if (= (length bindings) 0) + (message "which-key: No bindings found in %s" keymap-name) + (cond ((listp which-key-side-window-location) + (setq which-key--last-try-2-loc + (apply #'which-key--try-2-side-windows + bindings 0 which-key-side-window-location))) + (t (setq which-key--pages-plist + (which-key--create-pages bindings)) + (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 (binding) (let ((def (intern (cdr binding)))) @@ -2390,9 +2391,8 @@ is selected interactively by mode in `minor-mode-map-alist'." 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))) + (let ((formatted-keys + (which-key--get-bindings keymap #'which-key--evil-operator-filter))) (cond ((= (length formatted-keys) 0) (message "which-key: Keymap empty")) ((listp which-key-side-window-location) @@ -2421,10 +2421,7 @@ 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)) - filter)) + (formatted-keys (which-key--get-bindings from-keymap filter)) (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)) commit f2515410211c63da0d010ae1882ebd3fc5641a41 Author: Justin Burkett Date: Mon Feb 26 11:51:58 2018 -0500 Refactor show keymap functions diff --git a/which-key.el b/which-key.el index fe68c9db834..96e71907705 100644 --- a/which-key.el +++ b/which-key.el @@ -2289,38 +2289,38 @@ Only if no keys fit fallback to LOC2." (which-key--show-page page-n) loc2)))) -(defun which-key-show-keymap-1 (&optional all) - (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 - (let ((sym (symbol-at-point))) - (and (boundp sym) - (keymapp (symbol-value sym)) - (symbol-name sym))) - 'which-key-keymap-history)))) - (which-key--show-keymap (symbol-name keymap-sym) - (symbol-value keymap-sym) - nil all))) +(defun which-key--read-keymap () + "Read keymap symbol from minibuffer." + (intern + (completing-read "Keymap: " obarray + (lambda (m) + (and (boundp m) + (keymapp (symbol-value m)) + (not (equal (symbol-value m) + (make-sparse-keymap))))) + t + (let ((sym (symbol-at-point))) + (and (boundp sym) + (keymapp (symbol-value sym)) + (symbol-name sym))) + 'which-key-keymap-history))) ;;;###autoload -(defun which-key-show-keymap () +(defun which-key-show-keymap (keymap) "Show the top-level bindings in KEYMAP using which-key. KEYMAP is selected interactively from all available keymaps." - (interactive) - (which-key-show-keymap-1)) + (interactive (list (which-key--read-keymap))) + (which-key--show-keymap (symbol-name keymap) + (symbol-value keymap))) ;;;###autoload -(defun which-key-show-full-keymap () +(defun which-key-show-full-keymap (keymap) "Show all bindings in KEYMAP using which-key. KEYMAP is selected interactively from all available keymaps." - (interactive) - (which-key-show-keymap-1 t)) + (interactive (list (which-key--read-keymap))) + (which-key--show-keymap (symbol-name keymap) + (symbol-value keymap) + nil t)) ;;;###autoload (defun which-key-show-minor-mode-keymap () commit 0f80d0f95cbf133f52f64578d6a152e7e48ceb0e Author: Justin Burkett Date: Sun Feb 25 22:51:11 2018 -0500 Use symbol at point in whow keymap functions diff --git a/which-key.el b/which-key.el index 818ef17d2b7..fe68c9db834 100644 --- a/which-key.el +++ b/which-key.el @@ -2298,7 +2298,12 @@ Only if no keys fit fallback to LOC2." (keymapp (symbol-value m)) (not (equal (symbol-value m) (make-sparse-keymap))))) - t nil 'which-key-keymap-history)))) + t + (let ((sym (symbol-at-point))) + (and (boundp sym) + (keymapp (symbol-value sym)) + (symbol-name sym))) + 'which-key-keymap-history)))) (which-key--show-keymap (symbol-name keymap-sym) (symbol-value keymap-sym) nil all))) commit 7da9f8caf39cea3895712ce410876b2403d34392 Author: Justin Burkett Date: Sun Feb 25 22:36:10 2018 -0500 Fix which-key--show-keymap when no bidnings found which-key--get-formatted-key-bindings takes a nil argument to mean look for global bindings which is not what we want here. diff --git a/which-key.el b/which-key.el index 765fd37bd01..818ef17d2b7 100644 --- a/which-key.el +++ b/which-key.el @@ -2337,32 +2337,37 @@ is selected interactively by mode in `minor-mode-map-alist'." (cdr (assq mode-sym minor-mode-map-alist))))) (defun which-key--show-keymap (keymap-name keymap &optional prior-args all) - (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 all) - nil all))) - (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))))) + (let (unformatted-keys formatted-keys) + (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)) + (if (and (keymapp keymap) + (setq unformatted-keys (which-key--get-keymap-bindings keymap all)) + ;; need this in two steps otherwise + ;; `which-key--get-formatted-key-bindings' will look for global + ;; keys if second argument is nil + (setq formatted-keys (which-key--get-formatted-key-bindings + unformatted-keys nil all)) + (> (length formatted-keys) 0)) + (progn + (cond ((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))))) + (message "which-key: No bindings found in %s" keymap-name)))) (defun which-key--evil-operator-filter (binding) (let ((def (intern (cdr binding)))) commit b5f706398e7114314f34ea2096794cfec964ed30 Author: Justin Burkett Date: Sun Feb 25 22:35:38 2018 -0500 Detect menu-items in which-key--get-keymap-bindings diff --git a/which-key.el b/which-key.el index c4900e73844..765fd37bd01 100644 --- a/which-key.el +++ b/which-key.el @@ -1673,6 +1673,7 @@ ones. PREFIX is for internal use and should not be used." ((keymapp def) "Prefix Command") ((symbolp def) (copy-sequence (symbol-name def))) ((eq 'lambda (car-safe def)) "lambda") + ((eq 'menu-item (car-safe def)) "menu-item") (t (format "%s" def)))) bindings :test (lambda (a b) (string= (car a) (car b)))))))) keymap) commit 2e531873073ad2e224aba134ad0e7cc7b79512ae Author: Justin Burkett Date: Sat Feb 24 16:35:16 2018 -0500 Fix typo in previous commit diff --git a/which-key.el b/which-key.el index f16361d14c6..c4900e73844 100644 --- a/which-key.el +++ b/which-key.el @@ -1656,7 +1656,7 @@ alists. Returns a list (key separator description)." (defun which-key--get-keymap-bindings (keymap &optional all prefix) "Retrieve top-level bindings from KEYMAP. If ALL is non-nil, get all bindings, not just the top-level -one. PREFIX is for internal use and should not be used." +ones. PREFIX is for internal use and should not be used." (let (bindings) (map-keymap (lambda (ev def) commit fd714bca146280ddbf363ae25d731f7f964b940f Author: Justin Burkett Date: Sat Feb 24 16:33:13 2018 -0500 Fix docstring of which-key--get-keymap-bindings diff --git a/which-key.el b/which-key.el index 8d7256f42e0..f16361d14c6 100644 --- a/which-key.el +++ b/which-key.el @@ -1654,7 +1654,9 @@ alists. Returns a list (key separator description)." (nreverse new-list))) (defun which-key--get-keymap-bindings (keymap &optional all prefix) - "Retrieve top-level bindings from KEYMAP." + "Retrieve top-level bindings from KEYMAP. +If ALL is non-nil, get all bindings, not just the top-level +one. PREFIX is for internal use and should not be used." (let (bindings) (map-keymap (lambda (ev def) @@ -1663,7 +1665,8 @@ alists. Returns a list (key separator description)." (unless (string-match-p which-key--ignore-keys-regexp key-desc) (if (and all (keymapp def)) (setq bindings - (append bindings (which-key--get-keymap-bindings def t key))) + (append bindings + (which-key--get-keymap-bindings def t key))) (cl-pushnew (cons key-desc (cond commit caa18b20860fa9b77798da703fccbd3531ce59b2 Author: Justin Burkett Date: Sat Feb 24 16:29:33 2018 -0500 Fix descriptions of keys involving meta when showing keymaps diff --git a/which-key.el b/which-key.el index fa865bf466a..8d7256f42e0 100644 --- a/which-key.el +++ b/which-key.el @@ -1658,15 +1658,14 @@ alists. Returns a list (key separator description)." (let (bindings) (map-keymap (lambda (ev def) - (let ((key (if prefix - (concat prefix " " (key-description (list ev))) - (key-description (list ev))))) - (unless (string-match-p which-key--ignore-keys-regexp key) + (let* ((key (append prefix (list ev))) + (key-desc (key-description key))) + (unless (string-match-p which-key--ignore-keys-regexp key-desc) (if (and all (keymapp def)) (setq bindings (append bindings (which-key--get-keymap-bindings def t key))) (cl-pushnew - (cons key + (cons key-desc (cond ((keymapp def) "Prefix Command") ((symbolp def) (copy-sequence (symbol-name def))) commit ca991b0d3a1c0ff0ffae487d4bd1e7d7671708a7 Author: Justin Burkett Date: Fri Feb 23 13:48:51 2018 -0500 Autoload the show keymap functions diff --git a/which-key.el b/which-key.el index ab25ac9de23..fa865bf466a 100644 --- a/which-key.el +++ b/which-key.el @@ -2300,18 +2300,21 @@ Only if no keys fit fallback to LOC2." (symbol-value keymap-sym) nil all))) +;;;###autoload (defun which-key-show-keymap () "Show the top-level bindings in KEYMAP using which-key. KEYMAP is selected interactively from all available keymaps." (interactive) (which-key-show-keymap-1)) +;;;###autoload (defun which-key-show-full-keymap () "Show all bindings in KEYMAP using which-key. KEYMAP is selected interactively from all available keymaps." (interactive) (which-key-show-keymap-1 t)) +;;;###autoload (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'." commit 506c34829c6c2211046693c7482d4caa8b1a227f Author: Justin Burkett Date: Fri Feb 23 13:34:11 2018 -0500 Add which-key-show-full-keymap Command to show all bindings in a keymap recursively. Add test for new which-key--get-keymap-bindings functionality. diff --git a/which-key-tests.el b/which-key-tests.el index 5c17ab7f1c9..3e75d6fa62c 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -122,5 +122,28 @@ (should (equal (which-key--extract-key " a .. c") "a .. c")) (should (equal (which-key--extract-key "M-a a .. c") "a .. c"))) +(ert-deftest which-key-test--get-keymap-bindings () + (let ((map (make-sparse-keymap)) + which-key-replacement-alist) + (define-key map [which-key-a] '(which-key "blah")) + (define-key map "b" 'ignore) + (define-key map "c" "c") + (define-key map "dd" "dd") + (define-key map "eee" "eee") + (should (equal + (sort (which-key--get-keymap-bindings map) + (lambda (a b) (string-lessp (car a) (car b)))) + '(("b" . "ignore") + ("c" . "c") + ("d" . "Prefix Command") + ("e" . "Prefix Command")))) + (should (equal + (sort (which-key--get-keymap-bindings map t) + (lambda (a b) (string-lessp (car a) (car b)))) + '(("b" . "ignore") + ("c" . "c") + ("d d" . "dd") + ("e e e" . "eee")))))) + (provide 'which-key-tests) ;;; which-key-tests.el ends here diff --git a/which-key.el b/which-key.el index 68c5d0e6cbd..ab25ac9de23 100644 --- a/which-key.el +++ b/which-key.el @@ -1615,7 +1615,7 @@ return the docstring." (t (format "%s %s" current docstring))))) -(defun which-key--format-and-replace (unformatted) +(defun which-key--format-and-replace (unformatted &optional preserve-full-key) "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)." @@ -1645,24 +1645,34 @@ alists. Returns a list (key separator description)." (when (consp key-binding) (push (list (which-key--propertize-key - (which-key--extract-key (car key-binding))) + (if preserve-full-key + (car key-binding) + (which-key--extract-key (car key-binding)))) sep-w-face final-desc) new-list)))) (nreverse new-list))) -(defun which-key--get-keymap-bindings (keymap) +(defun which-key--get-keymap-bindings (keymap &optional all prefix) "Retrieve top-level bindings from KEYMAP." (let (bindings) (map-keymap (lambda (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))))) + (let ((key (if prefix + (concat prefix " " (key-description (list ev))) + (key-description (list ev))))) + (unless (string-match-p which-key--ignore-keys-regexp key) + (if (and all (keymapp def)) + (setq bindings + (append bindings (which-key--get-keymap-bindings def t key))) + (cl-pushnew + (cons key + (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)) @@ -1748,7 +1758,7 @@ Requires `which-key-compute-remaps' to be non-nil" (forward-line)) (nreverse bindings))))) -(defun which-key--get-formatted-key-bindings (&optional bindings filter) +(defun which-key--get-formatted-key-bindings (&optional bindings filter preserve-full-key) "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)))) @@ -1757,7 +1767,7 @@ BUFFER that follow the key sequence KEY-SEQ." (when which-key-sort-order (setq unformatted (sort unformatted which-key-sort-order))) - (which-key--format-and-replace unformatted))) + (which-key--format-and-replace unformatted preserve-full-key))) ;;; Functions for laying out which-key buffer pages @@ -2296,6 +2306,12 @@ is selected interactively from all available keymaps." (interactive) (which-key-show-keymap-1)) +(defun which-key-show-full-keymap () + "Show all bindings in KEYMAP using which-key. KEYMAP is +selected interactively from all available keymaps." + (interactive) + (which-key-show-keymap-1 t)) + (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'." @@ -2314,14 +2330,15 @@ is selected interactively by mode in `minor-mode-map-alist'." (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) +(defun which-key--show-keymap (keymap-name keymap &optional prior-args all) (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)))) + (which-key--get-keymap-bindings keymap all) + nil all))) (cond ((= (length formatted-keys) 0) (message "which-key: Keymap empty")) ((listp which-key-side-window-location) commit 6a4d2c2cc0e240cae1a4bb3526c3aab2d47665af Author: Justin Burkett Date: Fri Feb 23 13:32:19 2018 -0500 Extract which-key--ignore-keys-regexp and which-key-show-keymap-1 diff --git a/which-key.el b/which-key.el index 89c046846f9..68c5d0e6cbd 100644 --- a/which-key.el +++ b/which-key.el @@ -654,6 +654,11 @@ used.") (defvar which-key--previous-frame-size nil) (defvar which-key--prefix-title-alist nil) (defvar which-key--debug nil) +(defvar which-key--ignore-keys-regexp + (eval-when-compile + (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" + "select-window" "switch-frame" "-state" + "which-key-")))) (make-obsolete-variable 'which-key-prefix-name-alist nil "2016-10-05") (make-obsolete-variable 'which-key-prefix-title-alist nil "2016-10-05") @@ -1677,11 +1682,6 @@ Requires `which-key-compute-remaps' to be non-nil" (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" - "which-key-")))) (ignore-sections-regexp (eval-when-compile (regexp-opt '("Key translations" "Function key map translations" @@ -1719,7 +1719,7 @@ Requires `which-key-compute-remaps' to be non-nil" (save-match-data (cond ((member binding ignore-bindings)) - ((string-match-p ignore-keys-regexp key)) + ((string-match-p which-key--ignore-keys-regexp key)) ((and which-key--current-prefix (string-match (format "^%s[ \t]\\([^ \t]+\\)[ \t]+$" key-str-qt) key)) @@ -2276,10 +2276,7 @@ Only if no keys fit fallback to LOC2." (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) +(defun which-key-show-keymap-1 (&optional all) (let ((keymap-sym (intern (completing-read "Keymap: " obarray @@ -2290,7 +2287,14 @@ is selected interactively from all available keymaps." (make-sparse-keymap))))) t nil 'which-key-keymap-history)))) (which-key--show-keymap (symbol-name keymap-sym) - (symbol-value keymap-sym)))) + (symbol-value keymap-sym) + nil all))) + +(defun which-key-show-keymap () + "Show the top-level bindings in KEYMAP using which-key. KEYMAP +is selected interactively from all available keymaps." + (interactive) + (which-key-show-keymap-1)) (defun which-key-show-minor-mode-keymap () "Show the top-level bindings in KEYMAP using which-key. KEYMAP commit fce520f8af727bd33861f8d0f7655c01ea84ad85 Author: Justin Burkett Date: Wed Jan 31 09:06:19 2018 -0500 Improve which-key--format-and-replace Do a better job with nil descriptions diff --git a/which-key.el b/which-key.el index 827261dfd83..89c046846f9 100644 --- a/which-key.el +++ b/which-key.el @@ -1632,9 +1632,11 @@ alists. Returns a list (key separator description)." (hl-face (which-key--highlight-face orig-desc)) (key-binding (which-key--maybe-replace (cons keys orig-desc))) (final-desc (which-key--propertize-description - (cdr key-binding) group local hl-face orig-desc)) - (final-desc (which-key--maybe-add-docstring final-desc orig-desc)) - (final-desc (which-key--truncate-description final-desc))) + (cdr key-binding) group local hl-face orig-desc))) + (when final-desc + (setq final-desc + (which-key--truncate-description + (which-key--maybe-add-docstring final-desc orig-desc)))) (when (consp key-binding) (push (list (which-key--propertize-key commit e5db4b62560542d43c0763db5a170d5cc1cb2d5d Author: Justin Burkett Date: Wed Jan 31 09:02:55 2018 -0500 Handle null description in which-key--propertize-description Fixes #186 diff --git a/which-key.el b/which-key.el index ea4767d0c71..827261dfd83 100644 --- a/which-key.el +++ b/which-key.el @@ -1553,33 +1553,35 @@ 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))) - (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)) + (when description + (let* ((desc description) + (desc (if (string-match-p "^group:" desc) + (substring desc 6) desc)) + (desc (if group (concat which-key-prefix-prefix desc) 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." commit adc0d660ad495289042dd77bab1e9ca59b63e555 Author: Justin Burkett Date: Wed Jan 31 08:58:15 2018 -0500 Use safe version of propertize Should fix #186 diff --git a/which-key.el b/which-key.el index ae693713b47..ea4767d0c71 100644 --- a/which-key.el +++ b/which-key.el @@ -1492,12 +1492,17 @@ no title exists." which-key--current-show-keymap-name) (t ""))) +(defun which-key--propertize (string &rest properties) + "Version of `propertize' that checks type of STRING." + (when (stringp string) + (apply #'propertize string properties))) + (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)) + (let ((key-w-face (which-key--propertize key 'face 'which-key-key-face)) (regexp (concat "\\(" (mapconcat 'identity which-key-special-keys "\\|") "\\)")) @@ -1507,7 +1512,7 @@ If KEY contains any \"special keys\" defined in (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)) + (which-key--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)))) @@ -1516,7 +1521,7 @@ If KEY contains any \"special keys\" defined in (defsubst which-key--truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) - (dots (propertize ".." 'face last-face))) + (dots (which-key--propertize ".." 'face last-face))) (if (and which-key-max-description-length (> (length desc) which-key-max-description-length)) (concat (substring desc 0 which-key-max-description-length) dots) @@ -1594,8 +1599,8 @@ return the docstring." (doc (when (commandp orig-sym) (documentation orig-sym))) (docstring (when doc - (propertize (car (split-string doc "\n")) - 'face 'which-key-docstring-face)))) + (which-key--propertize (car (split-string doc "\n")) + 'face 'which-key-docstring-face)))) (cond ((not (and which-key-show-docstrings docstring)) current) ((eq which-key-show-docstrings 'docstring-only) @@ -1608,7 +1613,8 @@ return the docstring." 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)) + (which-key--propertize which-key-separator + 'face 'which-key-separator-face)) (local-map (current-local-map)) new-list) (dolist (key-binding unformatted) @@ -1911,8 +1917,8 @@ is the width of the live window." (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)))) + (which-key--propertize (format "[%s paging/help]" key) + 'face 'which-key-note-face)))) (eval-and-compile (if (fboundp 'universal-argument--description) @@ -1947,7 +1953,7 @@ including prefix arguments." (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))))) + (which-key--propertize dash 'face 'which-key-key-face))))) (defun which-key--get-popup-map () "Generate transient-map for use in the top level binding display." @@ -1971,17 +1977,17 @@ and a page count." (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) + (concat (which-key--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))))) + (which-key--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)) + (let* ((page-cnt (which-key--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") @@ -2207,13 +2213,13 @@ prefix) if `which-key-use-C-h-commands' is non nil." (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 + (which-key--propertize (concat " " (or which-key--current-show-keymap-name "Top-level bindings")) 'face 'which-key-note-face)) full-prefix - (propertize + (which-key--propertize (substitute-command-keys (concat " \\" commit 5493d22489d159a758cb3f5e5f34f191c35c58de Author: Justin Burkett Date: Wed Jan 31 08:04:24 2018 -0500 Fix description truncation when showing docstrings diff --git a/which-key.el b/which-key.el index 1f4bfa14429..ae693713b47 100644 --- a/which-key.el +++ b/which-key.el @@ -1515,10 +1515,12 @@ If KEY contains any \"special keys\" defined in (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)) + (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) + (dots (propertize ".." 'face last-face))) + (if (and which-key-max-description-length + (> (length desc) which-key-max-description-length)) + (concat (substring desc 0 which-key-max-description-length) dots) + desc))) (defun which-key--highlight-face (description) "Return the highlight face for DESCRIPTION if it has one." @@ -1549,8 +1551,7 @@ ORIGINAL-DESCRIPTION is the description given by (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))) + (desc (if group (concat which-key-prefix-prefix desc) desc))) (make-text-button desc nil 'face (cond (hl-face hl-face) (group 'which-key-group-description-face) @@ -1623,8 +1624,9 @@ alists. Returns a list (key separator description)." (hl-face (which-key--highlight-face orig-desc)) (key-binding (which-key--maybe-replace (cons keys orig-desc))) (final-desc (which-key--propertize-description - (cdr key-binding) group local hl-face orig-desc))) - (setq final-desc (which-key--maybe-add-docstring final-desc orig-desc)) + (cdr key-binding) group local hl-face orig-desc)) + (final-desc (which-key--maybe-add-docstring final-desc orig-desc)) + (final-desc (which-key--truncate-description final-desc))) (when (consp key-binding) (push (list (which-key--propertize-key commit 0aae4c8634f5e282d7b0c2037d291ab926134730 Author: Justin Burkett Date: Wed Jan 31 07:45:27 2018 -0500 Improve which-key-show-docstrings option Add setting docstring-only to omit command names. Add which-key-docstring-face. See #185 diff --git a/which-key.el b/which-key.el index 6ae8b725f82..1f4bfa14429 100644 --- a/which-key.el +++ b/which-key.el @@ -218,11 +218,15 @@ only the first match is used to perform replacements from (defcustom which-key-show-docstrings nil "If non-nil, show each command's docstring next to the command in the which-key buffer. This will only display the docstring up -to the first line break. You probably also want to adjust -`which-key-max-description-length' at the same time if you use -this feature." +to the first line break. If you set this variable to the symbol +docstring-only, then the command's name with be omitted. You +probably also want to adjust `which-key-max-description-length' +at the same time if you use this feature." :group 'which-key - :type 'boolean) + :type '(radio + (const :tag "Do not show docstrings" nil) + (const :tag "Add docstring to command names" t) + (const :tag "Replace command name with docstring" docstring-only))) (defcustom which-key-highlighted-command-list '() "A list of strings and/or cons cells used to highlight certain @@ -566,6 +570,11 @@ and it matches a string in `which-key-highlighted-command-list'." "Face for special keys (SPC, TAB, RET)" :group 'which-key-faces) +(defface which-key-docstring-face + '((t . (:inherit which-key-note-face))) + "Face for docstrings" + :group 'which-key-faces) + ;;;; Custom popup (defcustom which-key-custom-popup-max-dimensions-function nil @@ -1574,6 +1583,25 @@ ORIGINAL-DESCRIPTION is the description given by (match-string 1 key-str) (car (last (split-string key-str " "))))))) +(defun which-key--maybe-add-docstring (current original) + "Maybe concat a docstring to CURRENT and return result. +Specifically, do this if ORIGINAL is a command with a docstring +and `which-key-show-docstrings' is non-nil. If +`which-key-show-docstrings' is the symbol docstring-only, just +return the docstring." + (let* ((orig-sym (intern original)) + (doc (when (commandp orig-sym) + (documentation orig-sym))) + (docstring (when doc + (propertize (car (split-string doc "\n")) + 'face 'which-key-docstring-face)))) + (cond ((not (and which-key-show-docstrings docstring)) + current) + ((eq which-key-show-docstrings 'docstring-only) + docstring) + (t + (format "%s %s" current docstring))))) + (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 @@ -1596,15 +1624,7 @@ alists. Returns a list (key separator description)." (key-binding (which-key--maybe-replace (cons keys orig-desc))) (final-desc (which-key--propertize-description (cdr key-binding) group local hl-face orig-desc))) - (when (and which-key-show-docstrings - (commandp (intern orig-desc)) - (documentation (intern orig-desc))) - (setq final-desc - (format "%s %s" - final-desc - (car - (split-string - (documentation (intern orig-desc)) "\n"))))) + (setq final-desc (which-key--maybe-add-docstring final-desc orig-desc)) (when (consp key-binding) (push (list (which-key--propertize-key commit c71fbbbc3ec49bac4b73fe2700d633e3037c7ae4 Author: Justin Burkett Date: Tue Jan 30 20:29:51 2018 -0500 Add option to show docstrings in which-key buffer Implements a simple version of the suggestion in #185 diff --git a/which-key.el b/which-key.el index 3400491b867..6ae8b725f82 100644 --- a/which-key.el +++ b/which-key.el @@ -215,6 +215,15 @@ only the first match is used to perform replacements from :group 'which-key :type 'boolean) +(defcustom which-key-show-docstrings nil + "If non-nil, show each command's docstring next to the command +in the which-key buffer. This will only display the docstring up +to the first line break. You probably also want to adjust +`which-key-max-description-length' at the same time if you use +this feature." + :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 @@ -1584,14 +1593,24 @@ alists. Returns a list (key separator description)." (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)))) + (key-binding (which-key--maybe-replace (cons keys orig-desc))) + (final-desc (which-key--propertize-description + (cdr key-binding) group local hl-face orig-desc))) + (when (and which-key-show-docstrings + (commandp (intern orig-desc)) + (documentation (intern orig-desc))) + (setq final-desc + (format "%s %s" + final-desc + (car + (split-string + (documentation (intern orig-desc)) "\n"))))) (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)) + final-desc) new-list)))) (nreverse new-list))) commit 1219622b756f149efe4b44c625f2140c5229f936 Author: Justin Burkett Date: Mon Jan 8 22:30:21 2018 -0500 Remove debugging message diff --git a/which-key.el b/which-key.el index 41dfb332c7f..3400491b867 100644 --- a/which-key.el +++ b/which-key.el @@ -2152,7 +2152,6 @@ current evil state. " (interactive) (let ((last-command-event (string-to-char key))) (digit-argument key)) - (message "lce %s key %s pf %s" last-command-event key prefix-arg) (let ((current-prefix-arg prefix-arg)) (which-key-reload-key-sequence))) commit 1dd91df43606de66580060a8b9b6edc9145c34ba Author: Justin Burkett Date: Mon Jan 8 22:26:05 2018 -0500 Implement #182 Allow single digit arg to be set after C-h diff --git a/which-key.el b/which-key.el index f973c1973e0..41dfb332c7f 100644 --- a/which-key.el +++ b/which-key.el @@ -412,7 +412,16 @@ prefixes in `which-key-paging-prefixes'" ("\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))) + ("u" . which-key-undo-key) + ("1" . which-key-digit-argument) + ("2" . which-key-digit-argument) + ("3" . which-key-digit-argument) + ("4" . which-key-digit-argument) + ("5" . which-key-digit-argument) + ("6" . which-key-digit-argument) + ("7" . which-key-digit-argument) + ("8" . which-key-digit-argument) + ("9" . which-key-digit-argument))) (define-key map (car bind) (cdr bind))) map) "Keymap for C-h commands.") @@ -2016,12 +2025,14 @@ enough space based on your settings and frame size." prefix-keys) ;;; Paging functions ;;;###autoload -(defun which-key-reload-key-sequence (key-seq) +(defun which-key-reload-key-sequence (&optional 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))) +`listify-key-sequence'. If nil, KEY-SEQ defaults to +`which-key--current-key-list'. Any prefix arguments that were +used are reapplied to the new key sequence." + (let* ((key-seq (or key-seq (which-key--current-key-list))) + (next-event (mapcar (lambda (ev) (cons t ev)) key-seq))) (setq prefix-arg current-prefix-arg unread-command-events next-event))) @@ -2029,7 +2040,7 @@ reapplied to the new key sequence." "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)) + (which-key-reload-key-sequence) (if which-key--last-try-2-loc (let ((which-key-side-window-location which-key--last-try-2-loc) (which-key--multiple-locations t)) @@ -2038,7 +2049,7 @@ reapplied to the new key sequence." (which-key--start-paging-timer))) ;;;###autoload -(defun which-key-show-standard-help () +(defun which-key-show-standard-help (&optional _) "Call the command in `which-key--prefix-help-cmd-backup'. Usually this is `describe-prefix-bindings'." (interactive) @@ -2075,7 +2086,7 @@ case do nothing." (which-key-turn-page -1)))) ;;;###autoload -(defun which-key-show-next-page-cycle () +(defun which-key-show-next-page-cycle (&optional _) "Show the next page of keys, cycling from end to beginning after last page." (interactive) @@ -2083,7 +2094,7 @@ after last page." (which-key-turn-page 1))) ;;;###autoload -(defun which-key-show-previous-page-cycle () +(defun which-key-show-previous-page-cycle (&optional _) "Show the previous page of keys, cycling from beginning to end after first page." (interactive) @@ -2091,7 +2102,7 @@ after first page." (which-key-turn-page -1))) ;;;###autoload -(defun which-key-show-top-level () +(defun which-key-show-top-level (&optional _) "Show top-level bindings." (interactive) (setq which-key--using-top-level "Top-level bindings") @@ -2113,7 +2124,7 @@ current evil state. " (message "which-key: No map named %s" map-sym)))) ;;;###autoload -(defun which-key-undo-key () +(defun which-key-undo-key (&optional _) "Undo last keypress and force which-key update." (interactive) (let* ((key-lst (butlast (which-key--current-key-list))) @@ -2129,13 +2140,22 @@ current evil state. " (t (which-key-show-top-level))))) (defalias 'which-key-undo 'which-key-undo-key) -(defun which-key-abort () +(defun which-key-abort (&optional _) "Abort key sequence." (interactive) (let ((which-key-inhibit t)) (which-key--hide-popup-ignore-command) (keyboard-quit))) +(defun which-key-digit-argument (key) + "Version of `digit-argument' for use in `which-key-C-h-map'." + (interactive) + (let ((last-command-event (string-to-char key))) + (digit-argument key)) + (message "lce %s key %s pf %s" last-command-event key prefix-arg) + (let ((current-prefix-arg prefix-arg)) + (which-key-reload-key-sequence))) + ;;;###autoload (defun which-key-C-h-dispatch () "Dispatch C-h commands by looking up key in @@ -2166,12 +2186,14 @@ prefix) if `which-key-use-C-h-commands' is non nil." " \\[which-key-show-standard-help]" which-key-separator "help," " \\[which-key-abort]" - which-key-separator "abort")) + which-key-separator "abort" + " 1..9" + which-key-separator "digit-arg")) '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))))) + (if cmd (funcall cmd key) (which-key-turn-page 0))))) ;;; Update commit 7559a79e95aada65601f7413a1c3f08bfa34557b Author: Justin Burkett Date: Mon Jan 8 20:19:10 2018 -0500 Version 3.1.0 diff --git a/which-key.el b/which-key.el index cb6da90f831..f973c1973e0 100644 --- a/which-key.el +++ b/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.0.2 +;; Version: 3.1.0 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit ef384e781e6107850c7fadc78cb0675d7fe72e69 Author: Justin Burkett Date: Sun Dec 17 22:16:24 2017 -0500 Fix and improve define-key based replacements Check for equality of definition as well as the key sequence. Unless it's a prefix binding, in which case only check the key sequence. Make sure we apply kbd when looking up pseudo bindings. Move the logic into which-key--get-pseudo-binding. diff --git a/which-key.el b/which-key.el index d28f4a2223c..cb6da90f831 100644 --- a/which-key.el +++ b/which-key.el @@ -916,7 +916,7 @@ meant to be used as :before advice for `define-key'." (when (and (consp def) (stringp (car def)) (symbolp (cdr def))) - (define-key keymap (which-key--pseudo-key key) (car def))))) + (define-key keymap (which-key--pseudo-key key) `(which-key ,def))))) (when which-key-enable-extended-define-key (advice-add #'define-key :before #'which-key--process-define-key-args)) @@ -1358,14 +1358,28 @@ local bindings coming first. Within these categories order using (throw 'res res))))))) (nreverse res))) +(defun which-key--get-pseudo-binding (key-binding) + (let* ((pseudo-binding + (key-binding (which-key--pseudo-key (kbd (car key-binding)) t))) + (pseudo-binding (when pseudo-binding (cadr pseudo-binding))) + (pseudo-desc (when pseudo-binding (car pseudo-binding))) + (pseudo-def (when pseudo-binding (cdr pseudo-binding))) + (real-def (key-binding (kbd (car key-binding)))) + ;; treat keymaps as if they're nil bindings. This creates the + ;; possibility that we rename the wrong binding but this seems + ;; unlikely. + (real-def (unless (keymapp real-def) real-def))) + (when (and pseudo-binding + (eq pseudo-def real-def)) + (cons (car key-binding) pseudo-desc)))) + (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 ((menu-item-repl - (key-binding (which-key--pseudo-key (car key-binding) t)))) - (if menu-item-repl - (cons (car key-binding) menu-item-repl) + (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding))) + (if pseudo-binding + pseudo-binding (let* ((mode-res (which-key--get-replacements key-binding t)) (all-repls (or mode-res (which-key--get-replacements key-binding)))) commit c7e5f766d131cf760f181bdda780bcd63cf765cc Merge: 6247cb5e28c cd8d24d0247 Author: Justin Burkett Date: Sun Dec 17 13:17:13 2017 -0500 Merge pull request #183 from tarsiiformes/silencio Define which-key--current-key-list before using it commit cd8d24d02479d510e20a2854f23a770fa9c9516f Author: Jonas Bernoulli Date: Sun Dec 17 18:57:03 2017 +0100 Define which-key--current-key-list before using it Actually move the definition of the caller which-key--pseudo-key instead. diff --git a/which-key.el b/which-key.el index d0d11a69b02..d28f4a2223c 100644 --- a/which-key.el +++ b/which-key.el @@ -1334,15 +1334,6 @@ local bindings coming first. Within these categories order using (defsubst which-key--butlast-string (str) (mapconcat #'identity (butlast (split-string str)) " ")) -(defun which-key--pseudo-key (key &optional use-current-prefix) - "Replace the last key in the sequence KEY by a special symbol -in order for which-key to allow looking up a description for the key." - (let* ((seq (listify-key-sequence key)) - (final (intern (format "which-key-%s" (key-description (last seq)))))) - (if use-current-prefix - (vconcat (which-key--current-key-list) (list final)) - (vconcat (butlast seq) (list final))))) - (defun which-key--get-replacements (key-binding &optional use-major-mode) (let ((alist (or (and use-major-mode (cdr-safe @@ -1422,6 +1413,15 @@ which are strings. KEY is of the form produced by `key-binding'." map (kbd (which-key--current-key-string (car keydesc)))) (intern (cdr keydesc))))) +(defun which-key--pseudo-key (key &optional use-current-prefix) + "Replace the last key in the sequence KEY by a special symbol +in order for which-key to allow looking up a description for the key." + (let* ((seq (listify-key-sequence key)) + (final (intern (format "which-key-%s" (key-description (last seq)))))) + (if use-current-prefix + (vconcat (which-key--current-key-list) (list final)) + (vconcat (butlast seq) (list final))))) + (defun which-key--maybe-get-prefix-title (keys) "KEYS is a string produced by `key-description'. A title is possibly returned using commit 6247cb5e28c001ffa8e09a92f654990b324db424 Author: Justin Burkett Date: Sat Dec 16 22:11:59 2017 -0500 Simplify implementation of define-key based replacements When a description is provided through define-key using a definition like ("description" . def) place a additional binding in the map to a "pseudo key" making it easy for which-key to find these descriptions on the fly and at the right time (i.e., when the binding is active). which-key-enable-extended-define-key must be enabled for this to have an effect. diff --git a/which-key.el b/which-key.el index 1523c00382c..d0d11a69b02 100644 --- a/which-key.el +++ b/which-key.el @@ -909,21 +909,14 @@ If AT-ROOT is non-nil the binding is also placed at the root of MAP." map)) (defun which-key--process-define-key-args (keymap key def) - "When DEF takes the form (\"DESCRIPTION\". DEF), add an entry -to `which-key-replacement-alist' so that this binding is replaced -in which-key with DESCRIPTION. This function is meant to be used -as :before advice for `define-key'." + "When DEF takes the form (\"DESCRIPTION\". DEF), make sure +which-key uses \"DESCRIPTION\" for this binding. This function is +meant to be used as :before advice for `define-key'." (with-demoted-errors "Which-key extended define-key error: %s" (when (and (consp def) (stringp (car def)) (symbolp (cdr def))) - (let ((key-desc (regexp-quote (key-description key)))) - (push (cons (cons (format "%s\\'" key-desc) - (format "\\`%s\\'" (if (cdr def) - (symbol-name (cdr def)) - "Prefix Command"))) - (cons nil (car def))) - which-key-replacement-alist))))) + (define-key keymap (which-key--pseudo-key key) (car def))))) (when which-key-enable-extended-define-key (advice-add #'define-key :before #'which-key--process-define-key-args)) @@ -1341,6 +1334,15 @@ local bindings coming first. Within these categories order using (defsubst which-key--butlast-string (str) (mapconcat #'identity (butlast (split-string str)) " ")) +(defun which-key--pseudo-key (key &optional use-current-prefix) + "Replace the last key in the sequence KEY by a special symbol +in order for which-key to allow looking up a description for the key." + (let* ((seq (listify-key-sequence key)) + (final (intern (format "which-key-%s" (key-description (last seq)))))) + (if use-current-prefix + (vconcat (which-key--current-key-list) (list final)) + (vconcat (butlast seq) (list final))))) + (defun which-key--get-replacements (key-binding &optional use-major-mode) (let ((alist (or (and use-major-mode (cdr-safe @@ -1369,27 +1371,31 @@ local bindings coming first. Within these categories order using "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)))))))))) + (let ((menu-item-repl + (key-binding (which-key--pseudo-key (car key-binding) t)))) + (if menu-item-repl + (cons (car key-binding) menu-item-repl) + (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) @@ -1600,7 +1606,8 @@ Requires `which-key-compute-remaps' to be non-nil" (ignore-keys-regexp (eval-when-compile (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" - "select-window" "switch-frame" "-state")))) + "select-window" "switch-frame" "-state" + "which-key-")))) (ignore-sections-regexp (eval-when-compile (regexp-opt '("Key translations" "Function key map translations" commit 1694c6d1790236bce691eacbff00dae5dfa2c24f Author: Justin Burkett Date: Fri Dec 15 14:18:30 2017 -0500 Improve which-key--process-define-key-args Specify Prefix Command as an explicit match string to cut down on false positives. diff --git a/which-key.el b/which-key.el index fdef15b424c..1523c00382c 100644 --- a/which-key.el +++ b/which-key.el @@ -919,8 +919,9 @@ as :before advice for `define-key'." (symbolp (cdr def))) (let ((key-desc (regexp-quote (key-description key)))) (push (cons (cons (format "%s\\'" key-desc) - (when (cdr def) - (format "\\`%s\\'" (symbol-name (cdr def))))) + (format "\\`%s\\'" (if (cdr def) + (symbol-name (cdr def)) + "Prefix Command"))) (cons nil (car def))) which-key-replacement-alist))))) commit 7150aa97954483517aa8395e94c39af9b49516fc Author: Justin Burkett Date: Wed Dec 13 21:12:50 2017 -0500 Announce which-key-enable-extended-define-key in README diff --git a/README.org b/README.org index edde2a4788b..4b4f96bfdb0 100644 --- a/README.org +++ b/README.org @@ -2,6 +2,12 @@ [[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 + +*** 2017-12-13: Added =which-key-enable-extended-define-key= + Allows for a concise syntax to specify replacement text using =define-key= + or alternatives that use =define-key= internally. See the docstring and + [[#custom-string-replacement-options][Custom String Replacement]]. + *** 2017-11-13: Added =which-key-show-major-mode= Shows active bindings in current major-mode map. ** Introduction @@ -18,6 +24,7 @@ ** Table of Contents :TOC_3: - [[#which-key][which-key]] - [[#recent-changes][Recent Changes]] + - [[#2017-12-13-added-which-key-enable-extended-define-key][2017-12-13: Added =which-key-enable-extended-define-key=]] - [[#2017-11-13-added-which-key-show-major-mode][2017-11-13: Added =which-key-show-major-mode=]] - [[#introduction][Introduction]] - [[#install][Install]] @@ -221,6 +228,24 @@ 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=. +**** Automatic + A newer option is to set =which-key-enable-extended-define-key= which + advises =define-key= to allow which-key to pre-process its arguments. The + statement + + #+BEGIN_SRC emacs-lisp + (define-key some-map "f" '("foo" . long-name-for-command-foo)) + #+END_SRC + + is valid in Emacs. Setting this variable makes which-key automatically + replace the corresponding command name with the text in the string. A nice + example is in naming prefixes. The following binds "b" to =nil= and names + the binding as a prefix. + + #+BEGIN_SRC emacs-lisp + (define-key some-map "b" '("bar-prefix")) + #+END_SRC + **** "Key-Based" replacement Using this method, the description of a key is replaced using a string that you provide. Here's an example commit 555c5c1da8942b24d457578d0fc23564de07fb17 Author: Justin Burkett Date: Wed Dec 13 20:52:09 2017 -0500 Demote errors in which-key--process-define-key-args diff --git a/which-key.el b/which-key.el index 15b599a4f1c..fdef15b424c 100644 --- a/which-key.el +++ b/which-key.el @@ -913,15 +913,16 @@ If AT-ROOT is non-nil the binding is also placed at the root of MAP." to `which-key-replacement-alist' so that this binding is replaced in which-key with DESCRIPTION. This function is meant to be used as :before advice for `define-key'." - (when (and (consp def) - (stringp (car def)) - (symbolp (cdr def))) - (let ((key-desc (regexp-quote (key-description key)))) - (push (cons (cons (format "%s\\'" key-desc) - (when (cdr def) - (format "\\`%s\\'" (symbol-name (cdr def))))) - (cons nil (car def))) - which-key-replacement-alist)))) + (with-demoted-errors "Which-key extended define-key error: %s" + (when (and (consp def) + (stringp (car def)) + (symbolp (cdr def))) + (let ((key-desc (regexp-quote (key-description key)))) + (push (cons (cons (format "%s\\'" key-desc) + (when (cdr def) + (format "\\`%s\\'" (symbol-name (cdr def))))) + (cons nil (car def))) + which-key-replacement-alist))))) (when which-key-enable-extended-define-key (advice-add #'define-key :before #'which-key--process-define-key-args)) commit b6d04b3e9c281acf4093cf871b1639c730ad9618 Author: Justin Burkett Date: Wed Dec 13 13:06:55 2017 -0500 Fix .travis.yml Didn't install cask diff --git a/.travis.yml b/.travis.yml index 9da955d6225..918e5f19e92 100644 --- a/.travis.yml +++ b/.travis.yml @@ -9,9 +9,11 @@ env: before_install: - git clone https://github.com/rejeep/evm.git $HOME/.evm - - export PATH=$HOME/.evm/bin:$PATH + - export PATH="$HOME/.evm/bin:$PATH" + - export PATH="$HOME/.cask/bin:$PATH" - evm config path /tmp - evm install $EVM_EMACS --use --skip + - curl -fsSkL https://raw.github.com/cask/cask/master/go | python matrix: fast_finish: true commit 0a212c71fe4ed8bf3006f5936df7ba7c673cdcd9 Author: Justin Burkett Date: Wed Dec 13 13:02:51 2017 -0500 Fix travis build Add support for 25.3. Remove for 24.3 diff --git a/.travis.yml b/.travis.yml index b22aa137742..9da955d6225 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,29 +1,22 @@ -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 - +# language: emacs-lisp 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-25.3-travis - EVM_EMACS=emacs-git-snapshot-travis +before_install: + - git clone https://github.com/rejeep/evm.git $HOME/.evm + - export PATH=$HOME/.evm/bin:$PATH + - evm config path /tmp + - evm install $EVM_EMACS --use --skip + matrix: fast_finish: true allow_failures: - env: - - EVM_EMACS=emacs-24.3-travis - - EVM_EMACS=emacs-git-snapshot-travis + - env: EVM_EMACS=emacs-git-snapshot-travis script: - emacs --version diff --git a/Makefile b/Makefile index facb1f80b4b..a60edf68299 100644 --- a/Makefile +++ b/Makefile @@ -1,15 +1,15 @@ .PHONY : test -EMACS ?= emacs +emacs ?= emacs CASK ?= cask LOADPATH = -L . ELPA_DIR = \ - .cask/$(shell $(EMACS) -Q --batch --eval '(princ emacs-version)')/elpa + .cask/$(shell $(emacs) -Q --batch --eval '(princ emacs-version)')/elpa test: elpa - $(CASK) exec $(EMACS) -Q -batch $(LOADPATH) \ + $(CASK) exec $(emacs) -Q -batch $(LOADPATH) \ -l which-key-tests.el -f ert-run-tests-batch-and-exit elpa: $(ELPA_DIR) commit 3ff8f48193dce6670ac57f8e67469435bc0a71ba Author: Justin Burkett Date: Wed Dec 13 11:10:05 2017 -0500 Allow null DEF in which-key--process-define-key-args This is useful for naming prefixes diff --git a/which-key.el b/which-key.el index 22bed0869e5..15b599a4f1c 100644 --- a/which-key.el +++ b/which-key.el @@ -915,11 +915,11 @@ in which-key with DESCRIPTION. This function is meant to be used as :before advice for `define-key'." (when (and (consp def) (stringp (car def)) - (symbolp (cdr def)) - (cdr def)) + (symbolp (cdr def))) (let ((key-desc (regexp-quote (key-description key)))) (push (cons (cons (format "%s\\'" key-desc) - (format "\\`%s\\'" (symbol-name (cdr def)))) + (when (cdr def) + (format "\\`%s\\'" (symbol-name (cdr def))))) (cons nil (car def))) which-key-replacement-alist)))) commit f516b84eab1e307d3ffaa181324dca12c3951936 Author: Justin Burkett Date: Wed Dec 13 10:56:25 2017 -0500 Add which-key-enable-extended-define-key customization option Adds supporting which-key--process-define-key-args. The docstring for the option is Advise `define-key' to make which-key aware of definitions of the form (define-key KEYMAP KEY '("DESCRIPTION" . DEF)) With the advice, this definition will have the side effect of creating a replacement in `which-key-replacement-alist' that replaces DEF with DESCRIPTION when the key sequence ends in KEY. Using a cons cell like this is a valid definition for `define-key'. All this does is to make which-key aware of it. Since many higher level keybinding functions use `define-key' internally, this will affect most if not all of those as well. This variable must be set before loading which-key. diff --git a/which-key.el b/which-key.el index e0c03561cfc..22bed0869e5 100644 --- a/which-key.el +++ b/which-key.el @@ -476,6 +476,24 @@ it." :group 'which-key :type 'boolean) +(defcustom which-key-enable-extended-define-key nil + "Advise `define-key' to make which-key aware of definitions of the form + + \(define-key KEYMAP KEY '(\"DESCRIPTION\" . DEF)) + +With the advice, this definition will have the side effect of +creating a replacement in `which-key-replacement-alist' that +replaces DEF with DESCRIPTION when the key sequence ends in +KEY. Using a cons cell like this is a valid definition for +`define-key'. All this does is to make which-key aware of it. + +Since many higher level keybinding functions use `define-key' +internally, this will affect most if not all of those as well. + +This variable must be set before loading which-key." + :group 'which-key + :type 'boolean) + ;; Hooks (defcustom which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized." @@ -890,6 +908,24 @@ If AT-ROOT is non-nil the binding is also placed at the root of MAP." (which-key-define-key-recursively df key def t))) map)) +(defun which-key--process-define-key-args (keymap key def) + "When DEF takes the form (\"DESCRIPTION\". DEF), add an entry +to `which-key-replacement-alist' so that this binding is replaced +in which-key with DESCRIPTION. This function is meant to be used +as :before advice for `define-key'." + (when (and (consp def) + (stringp (car def)) + (symbolp (cdr def)) + (cdr def)) + (let ((key-desc (regexp-quote (key-description key)))) + (push (cons (cons (format "%s\\'" key-desc) + (format "\\`%s\\'" (symbol-name (cdr def)))) + (cons nil (car def))) + which-key-replacement-alist)))) + +(when which-key-enable-extended-define-key + (advice-add #'define-key :before #'which-key--process-define-key-args)) + ;;; Functions for computing window sizes (defun which-key--text-width-to-total (text-width) commit 78a29434789c7e7af7b3cf10a548d6247a69d3a9 Author: Justin Burkett Date: Thu Dec 7 17:30:49 2017 -0500 Fix ordering of default replacement-alist When which-key-allow-multiple-replacements is nil, this order is required to get the intended behavior with left and right. Ref #181 diff --git a/which-key.el b/which-key.el index 79f7affd852..e0c03561cfc 100644 --- a/which-key.el +++ b/which-key.el @@ -152,10 +152,10 @@ remapped given the currently active keymaps." `(((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") . ("→")))))) + '((("") . ("←")) + (("") . ("→")))) + (("<\\([[:alnum:]-]+\\)>") . ("\\1")))) "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 commit 159f0f9b78753574a1892ae3e47c8c1938965ea9 Author: Justin Burkett Date: Tue Dec 5 07:17:47 2017 -0500 Add notes about paging commands not working with minibuffer diff --git a/README.org b/README.org index 9ad7cb107d4..edde2a4788b 100644 --- a/README.org +++ b/README.org @@ -118,7 +118,9 @@ [[./img/which-key-minibuffer.png]] Note the maximum height of the minibuffer is controlled through the built-in - variable =max-mini-window-height=. + variable =max-mini-window-height=. Also, the paging commands do not work + reliably with the minibuffer option. Use the side window on the bottom + option if you need paging. ** Additional Commands - =which-key-show-top-level= will show most key bindings without a prefix. It diff --git a/which-key.el b/which-key.el index 348f50d9e23..79f7affd852 100644 --- a/which-key.el +++ b/which-key.el @@ -778,7 +778,10 @@ bottom." ;;;###autoload (defun which-key-setup-minibuffer () - "Apply suggested settings for minibuffer." + "Apply suggested settings for minibuffer. +Do not use this setup if you use the paging commands. Instead use +`which-key-setup-side-window-bottom', which is nearly identical +but more functional." (interactive) (which-key--setup-echo-keystrokes) (setq which-key-popup-type 'minibuffer commit 1234342878f9c9c9bc23ebe754e85d7fa155a51f Author: Justin Burkett Date: Tue Nov 14 10:10:43 2017 -0500 Re-indent README diff --git a/README.org b/README.org index 256abb89e3a..9ad7cb107d4 100644 --- a/README.org +++ b/README.org @@ -1,19 +1,20 @@ * 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]] - + [[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 *** 2017-11-13: Added =which-key-show-major-mode= Shows active bindings in current major-mode map. ** 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. - + =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]] @@ -45,405 +46,414 @@ the popup will look like are included below. =which-key= started as a rewrite of ** 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. - + 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 - + 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. - + 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 + 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]] - + #+END_SRC + + [[./img/which-key-bottom.png]] + *** Side Window Right Option -Popup side window on right. For defaults use - -#+BEGIN_SRC emacs-lisp + 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]] - + #+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 - + 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=. - + 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-major-mode= will show the currently active major-mode - bindings. It's similar to =C-h m= but in a which-key format. It is also aware - of evil commands defined using =evil-define-key=. -- =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. - + - =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-major-mode= will show the currently active major-mode + bindings. It's similar to =C-h m= but in a which-key format. It is also + aware of evil commands defined using =evil-define-key=. + - =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=. + 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. + 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. + #+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 + #+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 - + + #+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 - + 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=. - + 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. - + 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/pdcawley][@pdcawley]] 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. - + + 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/pdcawley][@pdcawley]] 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 - + 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. - + + 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. - + 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 == to the relevant command. - -#+BEGIN_SRC emacs-lisp + + Essentially, all you need to do for a prefix like =C-x= is the following + which will bind == to the relevant command. + + #+BEGIN_SRC emacs-lisp (define-key which-key-mode-map (kbd "C-x ") 'which-key-C-h-dispatch) -#+END_SRC - -This is completely equivalent to - -#+BEGIN_SRC emacs-lisp + #+END_SRC + + This is completely equivalent to + + #+BEGIN_SRC emacs-lisp (setq which-key-paging-prefixes '("C-x")) (setq which-key-paging-key "") -#+END_SRC - -where the latter are provided for convenience if you have a lot of prefixes. - + #+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 + 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 + #+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. - + #+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 + 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 @@ -464,16 +474,16 @@ shown. 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]] - + 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/bmag][@bmag]] for helping with the initial development and finding many bugs. -- [[https://github/iqbalansari][@iqbalansari]] who among other things adapted the code to make - =which-key-show-top-level= possible. + Special thanks to + - [[https://github.com/bmag][@bmag]] for helping with the initial development and finding many bugs. + - [[https://github/iqbalansari][@iqbalansari]] who among other things adapted the code to make + =which-key-show-top-level= possible. commit 29348528d28a76857149d03b9554583856286448 Author: Justin Burkett Date: Tue Nov 14 10:04:31 2017 -0500 Mention which-key-show-major-mode in README diff --git a/README.org b/README.org index ac8b97ffdb8..256abb89e3a 100644 --- a/README.org +++ b/README.org @@ -2,14 +2,8 @@ [[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]]. - +*** 2017-11-13: Added =which-key-show-major-mode= + Shows active bindings in current major-mode map. ** 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, @@ -21,34 +15,33 @@ 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]] +- [[#which-key][which-key]] + - [[#recent-changes][Recent Changes]] + - [[#2017-11-13-added-which-key-show-major-mode][2017-11-13: Added =which-key-show-major-mode=]] + - [[#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 @@ -128,6 +121,9 @@ 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-major-mode= will show the currently active major-mode + bindings. It's similar to =C-h m= but in a which-key format. It is also aware + of evil commands defined using =evil-define-key=. - =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. commit 6e8df961f4aecbbb59655ea804c62f09eb13b271 Author: Justin Burkett Date: Tue Nov 14 10:00:14 2017 -0500 Consolidate use of binding filters diff --git a/which-key.el b/which-key.el index 85714c870ab..348f50d9e23 100644 --- a/which-key.el +++ b/which-key.el @@ -1525,19 +1525,18 @@ alists. Returns a list (key separator description)." new-list)))) (nreverse new-list))) -(defun which-key--get-keymap-bindings (keymap &optional filter) +(defun which-key--get-keymap-bindings (keymap) "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)))))) + (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)) @@ -2204,9 +2203,10 @@ is selected interactively by mode in `minor-mode-map-alist'." (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--evil-operator-filter (binding) + (let ((def (intern (cdr binding)))) + (and (functionp def) + (not (evil-get-command-property def :suppress-operator))))) (defun which-key--show-evil-operator-keymap () (if which-key--inhibit-next-operator-popup @@ -2220,8 +2220,8 @@ is selected interactively by mode in `minor-mode-map-alist'." 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)))) + (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) commit 917d2ba291eb7fea7b5c1c9097be23ea356b2477 Author: Justin Burkett Date: Tue Nov 14 09:52:37 2017 -0500 Improve echo area note for which-key-show-major-mode diff --git a/which-key.el b/which-key.el index 0f5b7d45e54..85714c870ab 100644 --- a/which-key.el +++ b/which-key.el @@ -1399,7 +1399,7 @@ no title exists." (if alternate alternate (concat "Following " keys))) (t "")))) - (which-key--using-top-level "Top-level bindings") + (which-key--using-top-level which-key--using-top-level) (which-key--current-show-keymap-name which-key--current-show-keymap-name) (t ""))) @@ -2033,7 +2033,7 @@ after first page." (defun which-key-show-top-level () "Show top-level bindings." (interactive) - (setq which-key--using-top-level t) + (setq which-key--using-top-level "Top-level bindings") (which-key--create-buffer-and-show nil)) ;;;###autoload @@ -2044,7 +2044,7 @@ This function will also detect evil bindings made using `evil-define-key' in this map. These bindings will depend on the current evil state. " (interactive) - (setq which-key--using-top-level t) + (setq which-key--using-top-level "Major-mode bindings") (let ((map-sym (intern (format "%s-map" major-mode)))) (if (and (boundp map-sym) (keymapp (symbol-value map-sym))) (which-key--create-buffer-and-show commit 70d63a8babcc783cf0083b0094405d45303ec401 Author: Justin Burkett Date: Mon Nov 13 15:17:16 2017 -0500 Add which-key-show-major-mode This is a new function to discover bindings, including evil ones, in the keymap of the current major mode. It should be considered experimental at the moment. diff --git a/which-key.el b/which-key.el index 0e2c6dae586..0f5b7d45e54 100644 --- a/which-key.el +++ b/which-key.el @@ -1363,6 +1363,18 @@ which are strings. KEY is of the form produced by `key-binding'." (current-local-map) (kbd (which-key--current-key-string (car keydesc)))) (intern (cdr keydesc)))) +(defun which-key--map-binding-p (map keydesc) + (or + (when (bound-and-true-p evil-state) + (eq (which-key--safe-lookup-key + map + (kbd (which-key--current-key-string + (format "<%s-state> %s" evil-state (car keydesc))))) + (intern (cdr keydesc)))) + (eq (which-key--safe-lookup-key + 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 @@ -1615,10 +1627,12 @@ Requires `which-key-compute-remaps' to be non-nil" (forward-line)) (nreverse bindings))))) -(defun which-key--get-formatted-key-bindings (&optional bindings) +(defun which-key--get-formatted-key-bindings (&optional bindings filter) "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 filter + (setq unformatted (cl-remove-if-not filter unformatted))) (when which-key-sort-order (setq unformatted (sort unformatted which-key-sort-order))) @@ -2022,6 +2036,21 @@ after first page." (setq which-key--using-top-level t) (which-key--create-buffer-and-show nil)) +;;;###autoload +(defun which-key-show-major-mode () + "Show top-level bindings in the map of the current major mode. + +This function will also detect evil bindings made using +`evil-define-key' in this map. These bindings will depend on the +current evil state. " + (interactive) + (setq which-key--using-top-level t) + (let ((map-sym (intern (format "%s-map" major-mode)))) + (if (and (boundp map-sym) (keymapp (symbol-value map-sym))) + (which-key--create-buffer-and-show + nil nil (apply-partially #'which-key--map-binding-p (symbol-value map-sym))) + (message "which-key: No map named %s" map-sym)))) + ;;;###autoload (defun which-key-undo-key () "Undo last keypress and force which-key update." @@ -2215,7 +2244,7 @@ is selected interactively by mode in `minor-mode-map-alist'." (which-key--hide-popup) (setq unread-command-events (listify-key-sequence key)))))))) -(defun which-key--create-buffer-and-show (&optional prefix-keys from-keymap) +(defun which-key--create-buffer-and-show (&optional prefix-keys from-keymap filter) "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." (setq which-key--current-prefix prefix-keys @@ -2223,7 +2252,8 @@ Finally, show the buffer." (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)))) + (which-key--get-keymap-bindings from-keymap)) + filter)) (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)) commit 6d2e17c949ff7bfebfe0b0878a93d94b31585031 Author: Justin Burkett Date: Thu Aug 17 14:07:50 2017 -0400 Update which-key version for GNU ELPA diff --git a/which-key.el b/which-key.el index 78b16654a40..0e2c6dae586 100644 --- a/which-key.el +++ b/which-key.el @@ -5,7 +5,7 @@ ;; Author: Justin Burkett ;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.0.1 +;; Version: 3.0.2 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit 7c01092e65b2ea520af8ca36ee93cef49981d45a Author: Justin Burkett Date: Tue Aug 8 20:05:37 2017 -0400 Make minor changes to commentary in which-key.el diff --git a/which-key.el b/which-key.el index 0c4bb20e887..78b16654a40 100644 --- a/which-key.el +++ b/which-key.el @@ -24,14 +24,15 @@ ;;; Commentary: -;; 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 along with information about additional features can -;; be found at https://github.com/justbur/emacs-which-key. +;; 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: commit 527113d06ed4a69eeb97ee1359539b29fea8c858 Author: Justin Burkett Date: Mon Aug 7 16:27:12 2017 -0400 Assign copyright to FSF for ELPA diff --git a/which-key-tests.el b/which-key-tests.el index 1312f832c8d..5c17ab7f1c9 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -1,9 +1,9 @@ ;;; which-key-tests.el --- Tests for which-key.el -*- lexical-binding: t; -*- -;; Copyright (C) 2015 Justin Burkett +;; Copyright (C) 2017 Free Software Foundation, Inc. ;; Author: Justin Burkett -;; URL: https://github.com/justbur/emacs-which-key +;; Maintainer: Justin Burkett ;; 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 diff --git a/which-key.el b/which-key.el index d3b619c1124..0c4bb20e887 100644 --- a/which-key.el +++ b/which-key.el @@ -1,8 +1,9 @@ ;;; which-key.el --- Display available keybindings in popup -*- lexical-binding: t; -*- -;; Copyright (C) 2015 Justin Burkett +;; Copyright (C) 2017 Free Software Foundation, Inc. ;; Author: Justin Burkett +;; Maintainer: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key ;; Version: 3.0.1 ;; Keywords: @@ -32,9 +33,6 @@ ;; the popup will look like along with information about additional features can ;; be found at https://github.com/justbur/emacs-which-key. ;; -;; which-key started as a rewrite of guide-key -;; (https://github.com/kai2nenobu/guide-key), but the feature sets have since -;; diverged. ;;; Code: commit 3144b4c1fc774b63fc2350a0171e8ef01ab63298 Author: Justin Burkett Date: Tue May 30 08:25:52 2017 -0400 Fix which-key-show-remaining-keys option diff --git a/which-key.el b/which-key.el index 6e4ffeaf76a..d3b619c1124 100644 --- a/which-key.el +++ b/which-key.el @@ -590,8 +590,6 @@ Used when `which-key-popup-type' is frame.") "Internal: Backup the value of `prefix-help-command'.") (defvar which-key--pages-plist nil "Internal: Holds page objects") -(defvar which-key--lighter-backup nil - "Internal: Holds lighter backup") (defvar which-key--current-prefix nil "Internal: Holds current prefix") (defvar which-key--current-page-n nil @@ -979,6 +977,7 @@ total height." (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)) @@ -1764,8 +1763,6 @@ is the width of the live window." (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))) - (setq which-key--lighter-backup - (cadr (assq 'which-key-mode minor-mode-alist))) (setcar (cdr (assq 'which-key-mode minor-mode-alist)) (format " WK: %s/%s keys" n-shown n-tot))))) @@ -1773,7 +1770,7 @@ is the width of the live window." "Restore the lighter for which-key." (when which-key-show-remaining-keys (setcar (cdr (assq 'which-key-mode minor-mode-alist)) - which-key--lighter-backup))) + which-key-lighter))) (defun which-key--echo (text) "Echo TEXT to minibuffer without logging." commit 3ff303b50495d492cfac70cc9f7321971928bdb1 Author: Justin Burkett Date: Sun May 28 10:06:07 2017 -0400 Version 3.0.1 diff --git a/which-key.el b/which-key.el index ab3b3e1dea4..6e4ffeaf76a 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 3.0 +;; Version: 3.0.1 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit 000d7a68d1ea383d6cca7dcfb88ebcbb3c54190a Author: Justin Burkett Date: Sat May 27 15:34:54 2017 -0400 Handle C-h when buffer not showing which-key-C-h-dispatch was not doing anything different if the which-key buffer was not showing. This makes it fall back to the standard Emacs behavior. Fixes #172 diff --git a/which-key.el b/which-key.el index 137ab41d1e2..ab3b3e1dea4 100644 --- a/which-key.el +++ b/which-key.el @@ -2056,34 +2056,36 @@ after first page." `which-key-C-h-map'. This command is always accessible (from any prefix) if `which-key-use-C-h-commands' is non nil." (interactive) - (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 "") + (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 - (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-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)))) + (substitute-command-keys + (concat + " \\" + " \\[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 commit 32dad608abdb72c5d2df1e8bc3f3d350943d5c4e Merge: c61e63e9715 1c280772c35 Author: Justin Burkett Date: Sun May 21 08:49:54 2017 -0400 Merge pull request #171 from wyuenho/patch-1 Customize which-key-sort-order with list commit 1c280772c357247c1638b843574a1226742b9dfc Author: Jimmy Yuen Ho Wong Date: Sat May 20 23:46:12 2017 +0100 Customize which-key-sort-order with list This will display a list the user can choose from in customize instead of having them to type diff --git a/which-key.el b/which-key.el index 4dc772bfd9c..137ab41d1e2 100644 --- a/which-key.el +++ b/which-key.el @@ -355,7 +355,11 @@ are See the README and the docstrings for those functions for more information." :group 'which-key - :type 'function) + :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 commit c61e63e97156a8a15fe75e7251597a0f5f1887f5 Author: Justin Burkett Date: Fri May 19 17:55:13 2017 -0400 Adhere to 80 chars per column diff --git a/which-key.el b/which-key.el index 50a3f84baca..4dc772bfd9c 100644 --- a/which-key.el +++ b/which-key.el @@ -786,7 +786,8 @@ bottom." ;;; Helper functions to modify replacement lists. ;;;###autoload -(defun which-key-add-key-based-replacements (key-sequence replacement &rest more) +(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 @@ -795,7 +796,8 @@ may either be a string, as in a cons of two strings as in -\(which-key-add-key-based-replacements \"C-x 8\" '(\"unicode\" . \"Unicode keys\")\) +\(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. @@ -1022,7 +1024,8 @@ is shown, or if there is no need to start the closing timer." (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) +(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" @@ -1071,9 +1074,12 @@ call signature in different emacs versions" (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)))) + (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)) @@ -1106,8 +1112,8 @@ call signature in different emacs versions" (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))))) + (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) @@ -1148,8 +1154,10 @@ width) in lines and characters respectively." ;; 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)) + ;; 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)) @@ -1200,18 +1208,22 @@ width) in lines and characters respectively." (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--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 "" "\\1" a)) - (string-to-number (replace-regexp-in-string "" "\\1" b)))) + (< (string-to-number + (replace-regexp-in-string "" "\\1" a)) + (string-to-number + (replace-regexp-in-string "" "\\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--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)))))) @@ -1288,7 +1300,8 @@ local bindings coming first. Within these categories order using (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))) + (cdr-safe + (assq major-mode which-key-replacement-alist))) which-key-replacement-alist)) res case-fold-search) (catch 'res @@ -1451,7 +1464,8 @@ ORIGINAL-DESCRIPTION is the description given by ((and original-description (fboundp (intern original-description)) (documentation (intern original-description)) - (let* ((doc (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) @@ -1562,7 +1576,8 @@ Requires `which-key-compute-remaps' to be non-nil" (match-end 0)))) key binding) (when binding-start - (setq key (buffer-substring-no-properties (point) binding-start)) + (setq key (buffer-substring-no-properties + (point) binding-start)) (setq binding (buffer-substring-no-properties binding-start (line-end-position))) @@ -1575,21 +1590,26 @@ Requires `which-key-compute-remaps' to be non-nil" key-str-qt) key)) (unless (assoc-string (match-string 1 key) bindings) (push (cons (match-string 1 key) - (which-key--compute-binding binding)) bindings))) + (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)))) + (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) + (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))))))))) + (which-key--compute-binding binding)) + bindings))))))))) (forward-line)) (nreverse bindings))))) @@ -1740,14 +1760,16 @@ is the width of the live window." (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))) - (setq which-key--lighter-backup (cadr (assq 'which-key-mode minor-mode-alist))) + (setq which-key--lighter-backup + (cadr (assq 'which-key-mode minor-mode-alist))) (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-backup))) + (setcar (cdr (assq 'which-key-mode minor-mode-alist)) + which-key--lighter-backup))) (defun which-key--echo (text) "Echo TEXT to minibuffer without logging." @@ -1772,8 +1794,8 @@ is the width of the live window." (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 + ;; Backport of the definition of universal-argument--description in + ;; emacs25 on 2015-12-04 (when prefix-arg (concat "C-u" (pcase prefix-arg @@ -1840,8 +1862,9 @@ and a page count." (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) + (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) @@ -1879,7 +1902,9 @@ and a page count." (lambda () (with-current-buffer which-key--buffer (setq-local mode-line-format - (concat " " full-prefix " " status-line " " nxt-pg-hint)))))) + (concat " " full-prefix + " " status-line + " " nxt-pg-hint)))))) (_ (cons page nil))))) (defun which-key--show-page (n) @@ -1896,7 +1921,8 @@ enough space based on your settings and frame size." prefix-keys) (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)))) + (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)) @@ -2029,20 +2055,26 @@ prefix) if `which-key-use-C-h-commands' is non nil." (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)) + (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-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")) + " \\[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)) @@ -2059,7 +2091,9 @@ prefix) if `which-key-use-C-h-commands' is non nil." (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." + "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)) @@ -2088,9 +2122,11 @@ is selected interactively from all available keymaps." (lambda (m) (and (boundp m) (keymapp (symbol-value m)) - (not (equal (symbol-value m) (make-sparse-keymap))))) + (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)))) + (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 @@ -2201,7 +2237,8 @@ Finally, show the buffer." (* 1000 (float-time (time-since start-time))))))) (defun which-key--update () - "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." + "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]) @@ -2251,10 +2288,11 @@ Finally, show the buffer." (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)))) + (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 @@ -2265,7 +2303,8 @@ Finally, show the buffer." ;; 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)) + (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) @@ -2300,7 +2339,8 @@ Finally, show the buffer." (setq which-key--paging-timer (run-with-idle-timer 0.2 t (lambda () - (when (or (not (member real-last-command which-key--paging-functions)) + (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))))) commit 5dcf5d9b068ea42b8345dab5bb51e1e6aac19497 Author: Justin Burkett Date: Fri May 19 17:53:43 2017 -0400 Use regexp-opt for regexps * which-key.el (which-key--get-keymap-bindings): Update diff --git a/which-key.el b/which-key.el index 8f1b038292f..50a3f84baca 100644 --- a/which-key.el +++ b/which-key.el @@ -40,6 +40,7 @@ (require 'cl-lib) (require 'button) +(require 'regexp-opt) ;; For compiler (defvar evil-operator-shortcut-map) @@ -1526,9 +1527,16 @@ Requires `which-key-compute-remaps' to be non-nil" "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 "mouse-\\|wheel-\\|remap\\|drag-\\|scroll-bar\\|select-window\\|switch-frame\\|-state") - (ignore-sections-regexp "\\(Key translations\\|Function key map translations\\|Input decoding map translations\\)")) + (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) commit 23ca489988951823e8a21bb12ca73aac80cb9ba1 Author: Justin Burkett Date: Fri May 19 17:37:08 2017 -0400 Fixup previous commit * which-key.el (which-key--compute-binding): Need to copy name of remapped command Fixes #170 diff --git a/which-key.el b/which-key.el index fcb75cbd07b..8f1b038292f 100644 --- a/which-key.el +++ b/which-key.el @@ -1519,7 +1519,7 @@ Requires `which-key-compute-remaps' to be non-nil" (let (remap) (if (and which-key-compute-remaps (setq remap (command-remapping (intern binding)))) - (symbol-name remap) + (copy-sequence (symbol-name remap)) binding))) (defun which-key--get-current-bindings () commit e8db06ec4217d9b91170414d0efc37a7a26f9576 Author: Justin Burkett Date: Fri May 19 15:48:56 2017 -0400 Add which-key-compute-remaps option * which-key.el (which-key--compute-binding): Add (which-key--get-current-bindings): Modify to use prev function (which-key-compute-remaps): Add option Fixes #169 diff --git a/which-key.el b/which-key.el index cd77d194a79..fcb75cbd07b 100644 --- a/which-key.el +++ b/which-key.el @@ -131,6 +131,12 @@ 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") @@ -1506,6 +1512,16 @@ alists. Returns a list (key separator description)." 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)))) + (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))) @@ -1550,7 +1566,8 @@ alists. Returns a list (key separator description)." (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) binding) bindings))) + (push (cons (match-string 1 key) + (which-key--compute-binding binding)) bindings))) ((and which-key--current-prefix (string-match (format @@ -1559,10 +1576,12 @@ alists. Returns a list (key separator description)." (let ((stripped-key (concat (match-string 1 key) " \.\. " (match-string 2 key)))) (unless (assoc-string stripped-key bindings) - (push (cons stripped-key binding) 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) binding) bindings))))))))) + (push (cons (match-string 1 key) + (which-key--compute-binding binding)) bindings))))))))) (forward-line)) (nreverse bindings))))) commit bd20f56ad98edbc7e8a2d1c1e2327209e6cba093 Author: Justin Burkett Date: Tue May 16 08:37:06 2017 -0400 Version 3.0 diff --git a/which-key.el b/which-key.el index 4065e645359..cd77d194a79 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 2.0 +;; Version: 3.0 ;; Keywords: ;; Package-Requires: ((emacs "24.4")) commit 20146731c24635d5b86acb19ca5314f269f1892c Author: Justin Burkett Date: Tue May 16 08:34:44 2017 -0400 Prepare for ELPA release Update min emacs version to 24.4 to remove backported functions. Remove outdated comments. diff --git a/which-key.el b/which-key.el index 2bc30ba8f49..4065e645359 100644 --- a/which-key.el +++ b/which-key.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/justbur/emacs-which-key ;; Version: 2.0 ;; Keywords: -;; Package-Requires: ((emacs "24.3")) +;; 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 @@ -1506,7 +1506,6 @@ alists. Returns a list (key separator description)." keymap) bindings)) -;; adapted from helm-descbinds (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))) @@ -1530,12 +1529,8 @@ alists. Returns a list (key separator description)." (setq header-p nil) (forward-line 3)) ((= (char-after) ?\f) - ;; (push (cons header (nreverse section)) bindings) - ;; (setq section nil) (setq header-p t)) - ((looking-at "^[ \t]*$") - ;; ignore - ) + ((looking-at "^[ \t]*$")) ((or (not (string-match-p ignore-sections-regexp header)) which-key--current-prefix) (let ((binding-start (save-excursion @@ -1543,10 +1538,7 @@ alists. Returns a list (key separator description)." (match-end 0)))) key binding) (when binding-start - (setq key (buffer-substring-no-properties (point) binding-start) - ;; key (replace-regexp-in-string"^[ \t\n]+" "" key) - ;; key (replace-regexp-in-string"[ \t\n]+$" "" key) - ) + (setq key (buffer-substring-no-properties (point) binding-start)) (setq binding (buffer-substring-no-properties binding-start (line-end-position))) @@ -2185,11 +2177,6 @@ Finally, show the buffer." "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." (let ((prefix-keys (this-single-command-keys)) delay-time) - ;; (when (> (length prefix-keys) 0) - ;; (message "key: %s" (key-description prefix-keys))) - ;; (when (> (length prefix-keys) 0) - ;; (message "key binding: %s" (key-binding prefix-keys))) - ;; Taken from guide-key (when (and (equal prefix-keys [key-chord]) (bound-and-true-p key-chord-mode)) (setq prefix-keys @@ -2295,24 +2282,5 @@ Finally, show the buffer." (cancel-timer which-key--paging-timer) (which-key--start-timer)))))) -;;; backport some functions for 24.3 - -;; found at https://github.com/Lindydancer/andersl-old-emacs-support/blob/master/andersl-old-emacs-support.el -(unless (fboundp 'frame-fringe-width) - (defun frame-fringe-width (&optional frame) - "Return fringe width of FRAME in pixels." - (let ((left-pair (assq 'left-fringe (frame-parameters frame))) - (right-pair (assq 'right-fringe (frame-parameters frame)))) - (+ (if left-pair (cdr left-pair) 0) - (if right-pair (cdr right-pair) 0))))) - -(unless (fboundp 'frame-scroll-bar-width) - (defun frame-scroll-bar-width (&optional frame) - "Return scroll bar width of FRAME in pixels." - (let ((pair (assq 'scroll-bar-width (frame-parameters frame)))) - (if pair - (cdr pair) - 0)))) - (provide 'which-key) ;;; which-key.el ends here commit 806ef2439090af09503fc6179f23f95a7eaaef7f Author: Justin Burkett Date: Tue May 16 08:34:01 2017 -0400 Add .cask to gitignore diff --git a/.gitignore b/.gitignore index 77633d2fc83..de0966b3271 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ *.elc # Used to setup library paths for emacs -Q private-test-setup.el +/.cask/ commit 9a97df02c2314946703d062ca0b9c87ba63090f1 Author: Justin Burkett Date: Tue May 16 07:35:36 2017 -0400 Update emacs versions for Travis diff --git a/.travis.yml b/.travis.yml index cdea71fe995..b22aa137742 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,14 +11,18 @@ before_install: - 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: commit 9d2ba1bcba289fb81f92b797022b238c6b21f82e Author: Justin Burkett Date: Mon May 1 08:44:32 2017 -0400 Make -init-buffer-hook a custom var diff --git a/which-key.el b/which-key.el index 16b16c13480..2bc30ba8f49 100644 --- a/which-key.el +++ b/which-key.el @@ -467,8 +467,10 @@ it." :type 'boolean) ;; Hooks -(defvar which-key-init-buffer-hook '() - "Hook run when which-key buffer is initialized.") +(defcustom which-key-init-buffer-hook '() + "Hook run when which-key buffer is initialized." + :group 'which-key + :type 'hook) ;;;; Faces commit cd4310457920721e60eae520df6249aacd86afff Author: Justin Burkett Date: Wed Apr 26 20:57:49 2017 -0400 Add option to show transient maps Set which-key-show-transient-maps to a non-nil value to use this feature. When a transient map is active and it is not a hydra, show the keys from the map. Fixes #164 diff --git a/which-key.el b/which-key.el index 6cc4fd9fc31..16b16c13480 100644 --- a/which-key.el +++ b/which-key.el @@ -457,6 +457,15 @@ 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 (defvar which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized.") @@ -2147,13 +2156,15 @@ is selected interactively by mode in `minor-mode-map-alist'." (which-key--hide-popup) (setq unread-command-events (listify-key-sequence key)))))))) -(defun which-key--create-buffer-and-show (&optional prefix-keys) +(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)) + (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)) @@ -2233,6 +2244,12 @@ Finally, show the buffer." (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) commit 2e855196c78420b76f6f6cb92822255669599d7e Author: Justin Burkett Date: Tue Apr 18 08:01:40 2017 -0400 Improve which-key--any-match-p diff --git a/which-key.el b/which-key.el index 825e1cb0377..6cc4fd9fc31 100644 --- a/which-key.el +++ b/which-key.el @@ -2023,11 +2023,10 @@ prefix) if `which-key-use-C-h-commands' is non nil." (defun which-key--any-match-p (regexps string) "Non-nil if any of REGEXPS match STRING." - (let (match) + (catch 'match (dolist (regexp regexps) (when (string-match-p regexp string) - (setq match t))) - match)) + (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." commit bb30f56868ae4888a8ac5a406c7c7ee2ff168f9b Author: Justin Burkett Date: Fri Apr 7 09:05:10 2017 -0400 Fix customize type for replacement-alist Ref #165 diff --git a/which-key.el b/which-key.el index cc3cc0dc81c..825e1cb0377 100644 --- a/which-key.el +++ b/which-key.el @@ -183,8 +183,10 @@ 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 (alist :key-type regexp :value-type regexp) - :value-type (alist :key-type regexp :value-type regexp))) + :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 commit 3c7ecc69d48258af66978a685aedcbc8d1ada512 Author: Justin Burkett Date: Wed Mar 15 13:55:01 2017 -0400 Fix replacement of keys when prefix is nil The prefix is nil at the top-level keymap Fixes #163 diff --git a/which-key.el b/which-key.el index e9c2170ebdd..cc3cc0dc81c 100644 --- a/which-key.el +++ b/which-key.el @@ -1459,7 +1459,10 @@ alists. Returns a list (key separator description)." (let* ((key (car key-binding)) (orig-desc (cdr key-binding)) (group (which-key--group-p orig-desc)) - (keys (concat (which-key--current-key-string) " " key)) + ;; 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)) commit 0d56e4369b53af2c5960af4827b56b06d9162d62 Author: Justin Burkett Date: Thu Feb 9 10:27:41 2017 -0500 Fix handling of key ranges ("a .. d") When the last key in the key sequence is a range, extract the whole range instead of just the final key. Fixes #161 diff --git a/which-key-tests.el b/which-key-tests.el index aa50ec01ae7..1312f832c8d 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -99,7 +99,7 @@ '("SPC t 2" . "[ ] test mode"))))) (ert-deftest which-key-test--maybe-replace-multiple () - "Test `which-key-allow-multiple-replacements'. See #156" + "Test `which-key-allow-multiple-replacements'. See #156." (let ((which-key-replacement-alist '(((nil . "helm") . (nil . "HLM")) ((nil . "projectile") . (nil . "PRJTL")))) @@ -114,5 +114,13 @@ (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 " b a") "a")) + (should (equal (which-key--extract-key " 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/which-key.el b/which-key.el index 4a386a1fd73..e9c2170ebdd 100644 --- a/which-key.el +++ b/which-key.el @@ -1439,6 +1439,14 @@ ORIGINAL-DESCRIPTION is the description given by 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 @@ -1451,7 +1459,7 @@ alists. Returns a list (key separator description)." (let* ((key (car key-binding)) (orig-desc (cdr key-binding)) (group (which-key--group-p orig-desc)) - (keys (which-key--current-key-string key)) + (keys (concat (which-key--current-key-string) " " key)) (local (eq (which-key--safe-lookup-key local-map (kbd keys)) (intern orig-desc))) (hl-face (which-key--highlight-face orig-desc)) @@ -1459,7 +1467,7 @@ alists. Returns a list (key separator description)." (when (consp key-binding) (push (list (which-key--propertize-key - (car (last (split-string (car key-binding) " ")))) + (which-key--extract-key (car key-binding))) sep-w-face (which-key--propertize-description (cdr key-binding) group local hl-face orig-desc)) commit ea6f1dc5aacff2f3d909e410db05af01966555aa Author: Justin Burkett Date: Tue Feb 7 10:55:14 2017 -0500 Version 2.0 Increased major version for replacement list changes diff --git a/which-key.el b/which-key.el index 1585c87f84b..4a386a1fd73 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.15 +;; Version: 2.0 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 49ab7afd93ef36e5f0261eff7151360edeeea4e6 Author: Justin Burkett Date: Thu Dec 22 15:21:37 2016 -0500 Add which-key-show-prefix 'mode-line option See #157 diff --git a/which-key.el b/which-key.el index 9a44be9b458..1585c87f84b 100644 --- a/which-key.el +++ b/which-key.el @@ -240,6 +240,7 @@ and nil. Nil turns the feature off." (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 @@ -1825,9 +1826,17 @@ and a page count." nil)) (`echo (cons page - (concat full-prefix (when prefix-keys " ") - status-line (when status-line " ") - nxt-pg-hint))) + (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) @@ -1839,8 +1848,8 @@ and a page count." (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) - which-key--current-page-n page-n) + (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)) @@ -1852,7 +1861,7 @@ enough space based on your settings and frame size." prefix-keys) (erase-buffer) (insert (car page-echo)) (goto-char (point-min))) - (when (cdr page-echo) (which-key--echo (cdr page-echo))) + (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) commit a3a989e804bc1bc0b823cbd5facd326a82674074 Author: Justin Burkett Date: Tue Dec 20 16:03:21 2016 -0500 Update README diff --git a/README.org b/README.org index 764fcd46c76..ac8b97ffdb8 100644 --- a/README.org +++ b/README.org @@ -2,6 +2,8 @@ [[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 @@ -21,6 +23,7 @@ the popup will look like are included below. =which-key= started as a rewrite of ** 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]] @@ -398,6 +401,7 @@ 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. @@ -414,6 +418,10 @@ shown. ;; 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 commit 47c6f914c3985c5719edf710848d372fc2640b26 Author: Justin Burkett Date: Tue Dec 20 15:56:35 2016 -0500 Add which-key-max-display-columns See #157 diff --git a/which-key.el b/which-key.el index 6545026c7f2..9a44be9b458 100644 --- a/which-key.el +++ b/which-key.el @@ -256,6 +256,12 @@ and nil. Nil turns the feature off." :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 @@ -1608,7 +1614,7 @@ 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) + (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 @@ -1617,17 +1623,21 @@ metadata." (while cols-w-widths ;; start new page (cl-incf n-pages) - (setq col (pop cols-w-widths) - page-cols (list (cdr col)) - page-width (car col) - n-keys (length (cdr col))) + (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-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)) commit 07ff661a0b712dc70675ed84529ffe314f2db9ee Author: Justin Burkett Date: Thu Dec 15 09:58:32 2016 -0500 Remove unused variable diff --git a/which-key.el b/which-key.el index 56dad94e3c2..6545026c7f2 100644 --- a/which-key.el +++ b/which-key.el @@ -579,7 +579,6 @@ used.") (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--last-replace-key nil) (defvar which-key--prefix-title-alist nil) (defvar which-key--debug nil) commit 3cd9457f96f694fac3279416ccd366517d69cadd Author: Justin Burkett Date: Thu Dec 15 09:42:08 2016 -0500 Fix #156 by allowing multiple replacements Add which-key-allow-multiple-replacements which can be set to allow multiple replacements from which-key-replacement-alist to apply to a key binding. Switch from using assoc-default to find replacements to which-key--get-replacements. Adjusts tests and add a new one for multiple replacements. diff --git a/which-key-tests.el b/which-key-tests.el index 93e1dfa969f..aa50ec01ae7 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -51,7 +51,8 @@ '((("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)) + (test-mode-2 nil) + which-key-allow-multiple-replacements) (which-key-add-key-based-replacements "C-c ." "test ." "SPC ." "SPC ." @@ -97,5 +98,21 @@ (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"))))) + (provide 'which-key-tests) ;;; which-key-tests.el ends here diff --git a/which-key.el b/which-key.el index c5746a3f445..56dad94e3c2 100644 --- a/which-key.el +++ b/which-key.el @@ -177,7 +177,11 @@ 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." +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 (alist :key-type regexp :value-type regexp) :value-type (alist :key-type regexp :value-type regexp))) @@ -195,6 +199,14 @@ the key binding is ignored by which-key." 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 @@ -1248,46 +1260,54 @@ local bindings coming first. Within these categories order using (defsubst which-key--butlast-string (str) (mapconcat #'identity (butlast (split-string str)) " ")) -(defun which-key--replacement-test (alist-key key) - "`assoc-default' test to find bindings in `which-key-replacement-alist'. -Used in `which-key--maybe-replace'." - (let (case-fold-search) - (when (and (consp alist-key) - (or (null (car alist-key)) - (string-match-p (car alist-key) (car key))) - (or (null (cdr alist-key)) - (string-match-p (cdr alist-key) (cdr key)))) - (setq which-key--last-replace-key alist-key)))) +(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'." - (setq which-key--last-replace-key nil) - (let* ((mode-alist (assq major-mode which-key-replacement-alist)) - (mode-res (when mode-alist - (assoc-default - key-binding mode-alist 'which-key--replacement-test))) - (res (or mode-res - (assoc-default - key-binding which-key-replacement-alist - 'which-key--replacement-test)))) - (cond ((null res) key-binding) - ((functionp res) (funcall res key-binding)) - ((consp res) - (cons - (cond ((and (car res) (car which-key--last-replace-key)) - (replace-regexp-in-string - (car which-key--last-replace-key) - (car res) (car key-binding) t)) - ((car res) (car res)) - (t (car key-binding))) - (cond ((and (cdr res) (cdr which-key--last-replace-key)) - (replace-regexp-in-string - (cdr which-key--last-replace-key) - (cdr res) (cdr key-binding) t)) - ((cdr res) (cdr res)) - (t (cdr 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) commit f0eb183af6ce87344af40813a20fbe81bf98c80a Author: Justin Burkett Date: Mon Dec 12 09:04:44 2016 -0500 Tweak TOC in README and fix a link diff --git a/README.org b/README.org index 3972295d421..764fcd46c76 100644 --- a/README.org +++ b/README.org @@ -2,7 +2,7 @@ [[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-11-21] Replacement list changes +*** 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 @@ -18,8 +18,10 @@ 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@4: +** Table of Contents :TOC_3: - [[#which-key][which-key]] + - [[#recent-changes][Recent Changes]] + - [[#2016-11-21-replacement-list-changes][2016-11-21: Replacement list changes]] - [[#introduction][Introduction]] - [[#install][Install]] - [[#melpa][MELPA]] @@ -32,17 +34,9 @@ the popup will look like are included below. =which-key= started as a rewrite of - [[#additional-commands][Additional Commands]] - [[#special-features-and-configuration-options][Special Features and Configuration Options]] - [[#popup-type-options][Popup Type Options]] - - [[#minibuffer][minibuffer]] - - [[#side-window][side window]] - - [[#frame][frame]] - - [[#custom][custom]] - [[#custom-string-replacement-options][Custom String Replacement Options]] - - [[#key-based-replacement]["Key-Based" replacement]] - - [[#key-and-description-replacement][Key and Description replacement]] - [[#sorting-options][Sorting Options]] - [[#paging-options][Paging Options]] - - [[#method-1-default-using-c-h-or-help-char][Method 1 (default): Using C-h (or =help-char=)]] - - [[#method-2-bind-your-own-keys][Method 2: Bind your own keys]] - [[#face-customization-options][Face Customization Options]] - [[#other-options][Other Options]] - [[#support-for-third-party-libraries][Support for Third-Party Libraries]] @@ -215,6 +209,7 @@ current implementation of side-window bottom). #+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 commit c34cfd69a93ceb64ee6eb75468c32be06371eb8d Author: Justin Burkett Date: Wed Dec 7 10:14:08 2016 -0500 Add a missing type declaration diff --git a/which-key.el b/which-key.el index c8a08295c5f..c5746a3f445 100644 --- a/which-key.el +++ b/which-key.el @@ -202,7 +202,8 @@ 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) + :group 'which-key + :type '(repeat (choice string (cons regexp face)))) (defcustom which-key-special-keys '() "These keys will automatically be truncated to one character commit 786d800f61e25a1892c44f68a3e21c0507d03a1d Author: Justin Burkett Date: Mon Dec 5 14:09:36 2016 -0500 Prevent display from occurring twice in a row Found some cases where this could happen with a secondary idle delay. diff --git a/which-key.el b/which-key.el index 84beedace6b..c8a08295c5f 100644 --- a/which-key.el +++ b/which-key.el @@ -2171,12 +2171,13 @@ Finally, show the buffer." (bound-and-true-p god-local-mode) (eq this-command 'god-mode-self-insert)) (null this-command))) - (when (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)) + (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)) commit cf698ea25e8787c0440eabf7bdfd141329b6debf Author: Justin Burkett Date: Mon Dec 5 13:55:25 2016 -0500 Add basic timing facility for debugging. diff --git a/which-key.el b/which-key.el index d171b587ad0..84beedace6b 100644 --- a/which-key.el +++ b/which-key.el @@ -568,6 +568,7 @@ used.") (defvar which-key--previous-frame-size nil) (defvar which-key--last-replace-key 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") @@ -2100,7 +2101,8 @@ is selected interactively by mode in `minor-mode-map-alist'." Finally, show the buffer." (setq which-key--current-prefix prefix-keys which-key--last-try-2-loc nil) - (let ((formatted-keys (which-key--get-formatted-key-bindings)) + (let ((start-time (when which-key--debug (current-time))) + (formatted-keys (which-key--get-formatted-key-bindings)) (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)) @@ -2110,7 +2112,10 @@ Finally, show the buffer." 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))))) + (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'." commit 22928eeffa89a465ec50f4c4eb6c9617ae0e94a5 Author: Justin Burkett Date: Thu Dec 1 07:42:32 2016 -0500 Remove old obsolete variables/functions diff --git a/which-key.el b/which-key.el index 46bcfd10106..d171b587ad0 100644 --- a/which-key.el +++ b/which-key.el @@ -145,7 +145,7 @@ that represent a sub-map). Default is \"+\"." (delq nil `(((nil . "Prefix Command") . (nil . "prefix")) ((nil . "\\`\\?\\?\\'") . (nil . "lambda")) - ((nil . "which-key-show-next-page") . (nil . "wk next pg")) + ((nil . "which-key-show-next-page-no-cycle") . (nil . "wk next pg")) (("<\\([[:alnum:]-]+\\)>") . ("\\1")) ,@(unless which-key-dont-use-unicode '((("left") . ("←")) @@ -363,11 +363,6 @@ prefixes in `which-key-paging-prefixes'" a which-key paging command when which-key-mode is active." :group 'which-key :type 'boolean) -(defvaralias 'which-key-use-C-h-for-paging - 'which-key-use-C-h-commands) -(make-obsolete-variable 'which-key-use-C-h-for-paging - 'which-key-use-C-h-commands - "2015-12-2") (defcustom which-key-is-verbose nil "Whether to warn about potential mistakes in configuration." @@ -392,7 +387,6 @@ prefixes in `which-key-paging-prefixes'" (defvar which-key--paging-functions '(which-key-C-h-dispatch which-key-turn-page - which-key-show-next-page which-key-show-next-page-cycle which-key-show-next-page-no-cycle which-key-show-previous-page-cycle @@ -400,18 +394,6 @@ prefixes in `which-key-paging-prefixes'" which-key-undo-key which-key-undo)) -(defcustom which-key-prevent-C-h-from-cycling t - "When using C-h for paging, which-key overrides the default - behavior of calling `describe-prefix-bindings'. Setting this - variable to t makes it so that when on the last page, pressing - C-h calls the default function instead of cycling pages. If you - want which-key to cycle, set this to nil." - :group 'which-key - :type 'boolean) -(make-obsolete-variable 'which-key-prevent-C-h-from-cycling - "No longer applies. See `which-key-C-h-dispatch'" - "2015-12-2") - (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 @@ -1896,9 +1878,6 @@ call `which-key-show-standard-help'." which-key--on-last-page) (which-key-show-standard-help) (which-key-turn-page 1)))) -(defalias 'which-key-show-next-page 'which-key-show-next-page-no-cycle) -(make-obsolete 'which-key-show-next-page 'which-key-show-next-page-no-cycle - "2015-12-2") ;;;###autoload (defun which-key-show-previous-page-no-cycle () commit 474d5bfaa66080096dfb02c3b0c9abaa4ffdc8f4 Author: Justin Burkett Date: Thu Dec 1 07:39:19 2016 -0500 Add some docstrings diff --git a/which-key.el b/which-key.el index 990c9aae36e..46bcfd10106 100644 --- a/which-key.el +++ b/which-key.el @@ -1265,6 +1265,8 @@ local bindings coming first. Within these categories order using (mapconcat #'identity (butlast (split-string str)) " ")) (defun which-key--replacement-test (alist-key key) + "`assoc-default' test to find bindings in `which-key-replacement-alist'. +Used in `which-key--maybe-replace'." (let (case-fold-search) (when (and (consp alist-key) (or (null (car alist-key)) @@ -1472,6 +1474,7 @@ alists. Returns a list (key separator description)." ;; adapted from helm-descbinds (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")) @@ -1743,6 +1746,7 @@ including prefix arguments." (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) @@ -1752,6 +1756,9 @@ including prefix arguments." 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)) commit 0724e62ce520ba6176a61686980f8e1a90f382db Author: Justin Burkett Date: Thu Dec 1 07:39:03 2016 -0500 Remove some unused functions diff --git a/which-key.el b/which-key.el index 81060112029..990c9aae36e 100644 --- a/which-key.el +++ b/which-key.el @@ -763,31 +763,6 @@ bottom." ;;; Helper functions to modify replacement lists. -(defun which-key--add-key-val-to-alist (alist key value &optional alist-name) - "Internal function to add (KEY . VALUE) to ALIST." - (when (or (not (stringp key)) (not (or (stringp value) (consp value)))) - (error "which-key: Error %s (key) should be a string and %s (value) should\ - be a string or cons of two strings." - key value)) - (let ((keys (key-description (kbd key)))) - (cond ((null alist) (list (cons keys value))) - ((assoc-string keys alist) - (when (not (equal (cdr (assoc-string keys alist)) value)) - (when which-key-is-verbose - (message "which-key: changing %s name from %s to %s in the %s alist" - key (cdr (assoc-string keys alist)) value alist-name)) - (setcdr (assoc-string keys alist) value)) - alist) - (t (cons (cons keys value) alist))))) - -(defun which-key-replace-key-binding (match-cons replace-cons) - (lambda (key-binding) - (cons - (replace-regexp-in-string - (car match-cons) (car replace-cons) (car key-binding)) - (replace-regexp-in-string - (cdr match-cons) (cdr replace-cons) (cdr key-binding))))) - ;;;###autoload (defun which-key-add-key-based-replacements (key-sequence replacement &rest more) "Replace the description of KEY-SEQUENCE with REPLACEMENT. @@ -1719,19 +1694,6 @@ is the width of the live window." (let (message-log-max) (message "%s" text))) -;; Caused some completion commands in the minibuffer to be overwritten, so -;; disable the hack for now -;; (defun which-key--echo (text) -;; "Echo TEXT to minibuffer without logging." -;; (let* ((minibuffer (eq which-key-popup-type 'minibuffer)) -;; (delay (if minibuffer -;; 0.2 -;; (+ (or echo-keystrokes 0) 0.001))) -;; message-log-max) -;; (run-with-idle-timer -;; delay nil (lambda () (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)) commit 73dd5ad8827553c06de325f23c02e66fcbd669b2 Author: Justin Burkett Date: Wed Nov 30 19:09:20 2016 -0500 Fixup last commit part 2 diff --git a/which-key.el b/which-key.el index c4cf96b5f97..81060112029 100644 --- a/which-key.el +++ b/which-key.el @@ -814,7 +814,7 @@ replacements are added to ;; normalize key sequences before adding (let ((key-seq (key-description (kbd key-sequence))) (replace (or (and (functionp replacement) replacement) - (cdr-safe replacement) + (car-safe replacement) replacement))) (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) (if (functionp replace) replace (cons nil replace))) @@ -843,7 +843,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." ;; normalize key sequences before adding (let ((key-seq (key-description (kbd key-sequence))) (replace (or (and (functionp replacement) replacement) - (cdr-safe replacement) + (car-safe replacement) replacement))) (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) (if (functionp replace) replace (cons nil replace))) commit 1b8c1e5490296e1d44b7f1ffad1e27a3c4a34a4b Author: Justin Burkett Date: Wed Nov 30 19:03:56 2016 -0500 Fixup last commit diff --git a/which-key.el b/which-key.el index 63327cb9ba2..c4cf96b5f97 100644 --- a/which-key.el +++ b/which-key.el @@ -819,7 +819,7 @@ replacements are added to (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) (if (functionp replace) replace (cons nil replace))) which-key-replacement-alist) - (when (consp replacement) + (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)))) @@ -848,7 +848,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) (if (functionp replace) replace (cons nil replace))) mode-alist) - (when (consp replacement) + (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))) commit 8f4a21855f38650e3e3f2c5afa0aa95a3252e45c Author: Justin Burkett Date: Wed Nov 30 18:52:52 2016 -0500 Support functions in -add-key-based-replacements diff --git a/which-key-tests.el b/which-key-tests.el index 4fcbf395385..93e1dfa969f 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -49,12 +49,24 @@ "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 *"))))) + (("C-c .+" . nil) . ("C-c *" . "c-c *")))) + (test-mode-1 t) + (test-mode-2 nil)) (which-key-add-key-based-replacements "C-c ." "test ." "SPC ." "SPC ." "C-c \\" "regexp quoting" - "C-c [" "bad regexp") + "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 *"))) @@ -77,7 +89,13 @@ ;; see #155 (should (equal (which-key--maybe-replace '("SPC . ." . "don't 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"))))) (provide 'which-key-tests) ;;; which-key-tests.el ends here diff --git a/which-key.el b/which-key.el index d383866b7d6..63327cb9ba2 100644 --- a/which-key.el +++ b/which-key.el @@ -796,10 +796,13 @@ may either be a string, as in \(which-key-add-key-based-replacements \"C-x 1\" \"maximize\"\) -or a cons of two strings as in +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. @@ -809,9 +812,12 @@ replacements are added to ;; TODO: Make interactive (while key-sequence ;; normalize key sequences before adding - (let ((key-seq (key-description (kbd key-sequence)))) + (let ((key-seq (key-description (kbd key-sequence))) + (replace (or (and (functionp replacement) replacement) + (cdr-safe replacement) + replacement))) (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) - (cons nil (or (car-safe replacement) replacement))) + (if (functionp replace) replace (cons nil replace))) which-key-replacement-alist) (when (consp replacement) (push (cons key-seq (cdr-safe replacement)) @@ -835,9 +841,12 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (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)))) + (let ((key-seq (key-description (kbd key-sequence))) + (replace (or (and (functionp replacement) replacement) + (cdr-safe replacement) + replacement))) (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) - (cons nil (or (car-safe replacement) replacement))) + (if (functionp replace) replace (cons nil replace))) mode-alist) (when (consp replacement) (push (cons key-seq (cdr-safe replacement)) commit 0498eeab1fef008214c1ebfe1b01b92029e304bf Author: Justin Burkett Date: Wed Nov 30 08:58:53 2016 -0500 Fix links to users in README diff --git a/README.org b/README.org index f90dd4fe895..3972295d421 100644 --- a/README.org +++ b/README.org @@ -280,7 +280,7 @@ monospace font and alignment is based on character width. 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 @pdcawley in [[https://github.com/justbur/emacs-which-key/pull/147][PR #147]]. +ideas like this one suggested by [[https://github.com/pdcawley][@pdcawley]] in [[https://github.com/justbur/emacs-which-key/pull/147][PR #147]]. #+BEGIN_SRC emacs-lisp (push (cons '(nil . "paredit-mode") @@ -475,7 +475,6 @@ windows. ** Thanks Special thanks to -- @bmag for helping with the initial development and finding many - bugs. -- @iqbalansari who among other things adapted the code to make +- [[https://github.com/bmag][@bmag]] for helping with the initial development and finding many bugs. +- [[https://github/iqbalansari][@iqbalansari]] who among other things adapted the code to make =which-key-show-top-level= possible. commit b3f686dd6c672150c11c55103eca6e9cf635ecae Author: Justin Burkett Date: Wed Nov 30 08:56:05 2016 -0500 Add @pdcawley's example to README diff --git a/README.org b/README.org index a33cfd20bc0..f90dd4fe895 100644 --- a/README.org +++ b/README.org @@ -278,6 +278,22 @@ monospace font and alignment is based on character width. (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 @pdcawley 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 commit b57b3cb3424179264071773d581fed1e320dc0c3 Author: Justin Burkett Date: Wed Nov 30 08:39:52 2016 -0500 Add test for #155 diff --git a/which-key-tests.el b/which-key-tests.el index 244992df16a..4fcbf395385 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -52,6 +52,7 @@ (("C-c .+" . nil) . ("C-c *" . "c-c *"))))) (which-key-add-key-based-replacements "C-c ." "test ." + "SPC ." "SPC ." "C-c \\" "regexp quoting" "C-c [" "bad regexp") (should (equal @@ -61,18 +62,22 @@ (which-key--maybe-replace '("C-c b" . "test")) '("C-c a" . "c-c a"))) (should (equal - (which-key--maybe-replace '("C-c ." "not test .")) + (which-key--maybe-replace '("C-c ." . "not test .")) '("C-c ." . "test ."))) (should (not (equal - (which-key--maybe-replace '("C-c +" "not test .")) + (which-key--maybe-replace '("C-c +" . "not test .")) '("C-c ." . "test .")))) (should (equal - (which-key--maybe-replace '("C-c [" "orig bad regexp")) + (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"))))) + (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"))))) (provide 'which-key-tests) ;;; which-key-tests.el ends here commit 880a38ef92a5cc5d898047590766f3404699a100 Author: Justin Burkett Date: Wed Nov 30 07:03:52 2016 -0500 Fix bug in last commit The regexp-quote docstring is misleading since (regexp-quote "SPC x") will match "SPC x c". Added back the beginning and end markers in the regexp. diff --git a/which-key.el b/which-key.el index 7d99fa597a3..d383866b7d6 100644 --- a/which-key.el +++ b/which-key.el @@ -810,7 +810,7 @@ replacements are added to (while key-sequence ;; normalize key sequences before adding (let ((key-seq (key-description (kbd key-sequence)))) - (push (cons (cons (regexp-quote key-seq) nil) + (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) (cons nil (or (car-safe replacement) replacement))) which-key-replacement-alist) (when (consp replacement) @@ -836,7 +836,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (while key-sequence ;; normalize key sequences before adding (let ((key-seq (key-description (kbd key-sequence)))) - (push (cons (cons (regexp-quote key-seq) nil) + (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) (cons nil (or (car-safe replacement) replacement))) mode-alist) (when (consp replacement) commit a2b3383f49530fd4a99e924e8b7973f468795a9d Author: Justin Burkett Date: Tue Nov 29 21:29:32 2016 -0500 Quote regexp in -add-key-based-replacements Should fix #154 diff --git a/which-key-tests.el b/which-key-tests.el index cd055015a19..244992df16a 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -45,5 +45,34 @@ (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 *"))))) + (which-key-add-key-based-replacements + "C-c ." "test ." + "C-c \\" "regexp quoting" + "C-c [" "bad regexp") + (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"))))) + (provide 'which-key-tests) ;;; which-key-tests.el ends here diff --git a/which-key.el b/which-key.el index 496d2cbebd7..7d99fa597a3 100644 --- a/which-key.el +++ b/which-key.el @@ -810,7 +810,7 @@ replacements are added to (while key-sequence ;; normalize key sequences before adding (let ((key-seq (key-description (kbd key-sequence)))) - (push (cons (cons (format "\\`%s\\'" key-seq) nil) + (push (cons (cons (regexp-quote key-seq) nil) (cons nil (or (car-safe replacement) replacement))) which-key-replacement-alist) (when (consp replacement) @@ -836,7 +836,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (while key-sequence ;; normalize key sequences before adding (let ((key-seq (key-description (kbd key-sequence)))) - (push (cons (cons (format "\\`%s\\'" key-seq) nil) + (push (cons (cons (regexp-quote key-seq) nil) (cons nil (or (car-safe replacement) replacement))) mode-alist) (when (consp replacement) commit 9110eebc366d767adc14f16ecfc3eac418666beb Author: Justin Burkett Date: Tue Nov 29 13:20:00 2016 -0500 Fix a README link diff --git a/README.org b/README.org index d61585376b3..a33cfd20bc0 100644 --- a/README.org +++ b/README.org @@ -6,7 +6,7 @@ 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%20String%20Replacement%20Options][Custom String Replacement Options]]. +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 commit 2b78bdd26d3d5385b473f18bb217915488e0d3ff Author: Justin Burkett Date: Tue Nov 29 08:38:21 2016 -0500 Normalize key sequences from -add-key-based-replacements diff --git a/which-key.el b/which-key.el index 9acb29bb2d4..496d2cbebd7 100644 --- a/which-key.el +++ b/which-key.el @@ -808,12 +808,14 @@ replacements are added to `which-key-key-based-description-replacement-alist'." ;; TODO: Make interactive (while key-sequence - (push (cons (cons (format "\\`%s\\'" key-sequence) nil) - (cons nil (or (car-safe replacement) replacement))) - which-key-replacement-alist) - (when (consp replacement) - (push (cons key-sequence (cdr-safe replacement)) - which-key--prefix-title-alist)) + ;; normalize key sequences before adding + (let ((key-seq (key-description (kbd key-sequence)))) + (push (cons (cons (format "\\`%s\\'" key-seq) nil) + (cons nil (or (car-safe replacement) replacement))) + which-key-replacement-alist) + (when (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) @@ -832,12 +834,14 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (title-mode-alist (or (cdr-safe (assq mode which-key--prefix-title-alist)) (list)))) (while key-sequence - (push (cons (cons (format "\\`%s\\'" key-sequence) nil) - (cons nil (or (car-safe replacement) replacement))) - mode-alist) - (when (consp replacement) - (push (cons key-sequence (cdr-safe replacement)) - title-mode-alist)) + ;; normalize key sequences before adding + (let ((key-seq (key-description (kbd key-sequence)))) + (push (cons (cons (format "\\`%s\\'" key-seq) nil) + (cons nil (or (car-safe replacement) replacement))) + mode-alist) + (when (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) commit a32ec0c45a73e1d03e3e79203aa808803b00ba5c Author: Justin Burkett Date: Mon Nov 28 10:10:18 2016 -0500 Simplify --format-and-replace diff --git a/which-key.el b/which-key.el index 6828f42fe2d..9acb29bb2d4 100644 --- a/which-key.el +++ b/which-key.el @@ -1445,26 +1445,26 @@ 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))) - (delq - nil - (mapcar - (lambda (key-binding) - (let* ((key (car key-binding)) - (orig-desc (cdr key-binding)) - (group (which-key--group-p orig-desc)) - (keys (which-key--current-key-string 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) - (list (which-key--propertize-key - (car (last (split-string (car key-binding) " ")))) - sep-w-face - (which-key--propertize-description - (cdr key-binding) group local hl-face orig-desc))))) - unformatted)))) + (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)) + (keys (which-key--current-key-string 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 + (car (last (split-string (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." commit 0ac09351c4dc346d0c1d70d180c15732a4b2a3d7 Author: Justin Burkett Date: Fri Nov 25 09:00:25 2016 -0500 Fix use of function in -replacement-alist Wasn't actually deleting nil results diff --git a/which-key.el b/which-key.el index b5b671c3833..6828f42fe2d 100644 --- a/which-key.el +++ b/which-key.el @@ -1299,6 +1299,7 @@ which are strings. KEY is of the form produced by `key-binding'." key-binding which-key-replacement-alist 'which-key--replacement-test)))) (cond ((null res) key-binding) + ((functionp res) (funcall res key-binding)) ((consp res) (cons (cond ((and (car res) (car which-key--last-replace-key)) @@ -1312,8 +1313,7 @@ which are strings. KEY is of the form produced by `key-binding'." (cdr which-key--last-replace-key) (cdr res) (cdr key-binding) t)) ((cdr res) (cdr res)) - (t (cdr key-binding))))) - ((functionp res) (funcall res key-binding))))) + (t (cdr key-binding)))))))) (defsubst which-key--current-key-list (&optional key-str) (append (listify-key-sequence which-key--current-prefix) @@ -1446,22 +1446,25 @@ 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))) - (mapcar - (lambda (key-binding) - (let* ((key (car key-binding)) - (orig-desc (cdr key-binding)) - (group (which-key--group-p orig-desc)) - (keys (which-key--current-key-string 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)))) - (list (which-key--propertize-key - (car (last (split-string (car key-binding) " ")))) - sep-w-face - (which-key--propertize-description - (cdr key-binding) group local hl-face orig-desc)))) - unformatted))) + (delq + nil + (mapcar + (lambda (key-binding) + (let* ((key (car key-binding)) + (orig-desc (cdr key-binding)) + (group (which-key--group-p orig-desc)) + (keys (which-key--current-key-string 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) + (list (which-key--propertize-key + (car (last (split-string (car key-binding) " ")))) + sep-w-face + (which-key--propertize-description + (cdr key-binding) group local hl-face orig-desc))))) + unformatted)))) (defun which-key--get-keymap-bindings (keymap &optional filter) "Retrieve top-level bindings from KEYMAP." commit 3c4ca65395b7df3eb98088d694525ccf1507ae35 Author: Justin Burkett Date: Fri Nov 25 07:56:06 2016 -0500 Don't use case-fold-search in --maybe-replace See https://github.com/syl20bnr/spacemacs/issues/7837#issuecomment-262938480 diff --git a/which-key.el b/which-key.el index 50537810a74..b5b671c3833 100644 --- a/which-key.el +++ b/which-key.el @@ -1277,14 +1277,18 @@ local bindings coming first. Within these categories order using (mapconcat #'identity (butlast (split-string str)) " ")) (defun which-key--replacement-test (alist-key key) - (when (and (consp alist-key) - (or (null (car alist-key)) - (string-match-p (car alist-key) (car key))) - (or (null (cdr alist-key)) - (string-match-p (cdr alist-key) (cdr key)))) - (setq which-key--last-replace-key alist-key))) + (let (case-fold-search) + (when (and (consp alist-key) + (or (null (car alist-key)) + (string-match-p (car alist-key) (car key))) + (or (null (cdr alist-key)) + (string-match-p (cdr alist-key) (cdr key)))) + (setq which-key--last-replace-key alist-key)))) (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'." (setq which-key--last-replace-key nil) (let* ((mode-alist (assq major-mode which-key-replacement-alist)) (mode-res (when mode-alist commit b5a9d7d1ce028ce904cb8479a10440ad6c839221 Author: Justin Burkett Date: Tue Nov 22 07:01:09 2016 -0500 Update test diff --git a/which-key-tests.el b/which-key-tests.el index e620c3ae3e1..cd055015a19 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -30,20 +30,20 @@ (ert-deftest which-key-test-prefix-declaration () "Test `which-key-declare-prefixes' and `which-key-declare-prefixes-for-mode'. See Bug #109." - (let* (test-mode which-key-key-based-description-replacement-alist) - (which-key-declare-prefixes + (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-declare-prefixes-for-mode 'test-mode + (which-key-add-major-mode-key-based-replacements 'test-mode "C-c C-c" '("complete" . "complete title") "C-c C-k" "cancel") (should (equal - (assoc-string "SPC C-k" which-key-key-based-description-replacement-alist) + (which-key--maybe-replace '("SPC C-k" . "")) '("SPC C-k" . "cancel"))) (should (equal - (assoc-string - "C-c C-c" (cdr (assq 'test-mode which-key-key-based-description-replacement-alist))) - '("C-c C-c" . ("complete" . "complete title")))))) + (which-key--maybe-replace '("C-c C-c" . "")) + '("C-c C-c" . "complete"))))) (provide 'which-key-tests) ;;; which-key-tests.el ends here commit 19186917eb2958c11a297b03b7963e02053959ec Author: Justin Burkett Date: Mon Nov 21 23:03:12 2016 -0500 Consolidate replacements into one alist New list is which-key-replacement-alist. See docstring. The following lists are deprecated. Some basic backwards compatibility is attempted, but more complicated configs will likely break. which-key-key-replacement-alist which-key-key-based-description-replacement-alist which-key-description-replacement-alist which-key-binding-filter-function was removed, since it's functionality is mostly replaced by which-key-replacement-alist Updated README diff --git a/README.org b/README.org index 059fe296ca8..d61585376b3 100644 --- a/README.org +++ b/README.org @@ -1,15 +1,22 @@ * 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-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%20String%20Replacement%20Options][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 +=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. +[[https://github.com/kai2nenobu/guide-key][guide-key-mode]], but the feature sets have diverged to a certain extent. ** Table of Contents :TOC@4: - [[#which-key][which-key]] @@ -214,13 +221,8 @@ 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 -[Note on 2015-9-3 the format of -=which-key-key-based-description-replacement-alist= changed. It will be easier -to use the functions below in your configuration, instead of modifying this -variable directly.] - Using this method, the description of a key is replaced using a string that you -provide. Here's an example +provide. Here's an example #+BEGIN_SRC emacs-lisp (which-key-add-key-based-replacements @@ -245,20 +247,23 @@ 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 variables are -=which-key-key-replacement-alist= and =which-key-description-replacement-alist=. +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 -("<\\([[:alnum:]-]+\\)>" . "\\1") +(push '(("<\\([[:alnum:]-]+\\)>" . nil) . ("\\1" . nil)) + which-key-replacement-alist) #+END_SRC -The =car= takes a string which may use Emacs regexp and the =cdr= takes a string -with the replacement text. As shown, you can specify a sub-expression of the -match. The replacements do not need to use regexp and can be as simple as +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 -("left" . "lft") +(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 @@ -267,10 +272,10 @@ 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-key-replacement-alist '("TAB" . "↹")) -(add-to-list 'which-key-key-replacement-alist '("RET" . "⏎")) -(add-to-list 'which-key-key-replacement-alist '("DEL" . "⇤")) -(add-to-list 'which-key-key-replacement-alist '("SPC" . "␣")) +(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 *** Sorting Options diff --git a/which-key.el b/which-key.el index 4f77379f451..50537810a74 100644 --- a/which-key.el +++ b/which-key.el @@ -131,42 +131,69 @@ that represent a sub-map). Default is \"+\"." :group 'which-key :type 'string) -(defcustom which-key-key-replacement-alist - (if which-key-dont-use-unicode - '(("<\\([[:alnum:]-]+\\)>" . "\\1")) - '(("<\\([[:alnum:]-]+\\)>" . "\\1") ("left" . "←") ("right" . "→"))) - "The strings in the car of each cons are replaced with the -strings in the cdr for each key. Elisp regexp can be used as -in the first example." +(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") . (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." :group 'which-key - :type '(alist :key-type regexp :value-type string)) - -(defcustom which-key-description-replacement-alist - '(("Prefix Command" . "prefix") ("which-key-show-next-page" . "wk next pg") - ("\\`\\?\\?\\'" . "lambda")) - "See `which-key-key-replacement-alist'. -This is a list of lists for replacing descriptions." - :group 'which-key - :type '(alist :key-type regexp :value-type string)) - -(defcustom which-key-binding-filter-function nil - "Optional function to use to filter key bindings before they -are processed by which-key. The function should accept a cons -cell of the form (\"KEY\" . \"BINDING\") and the current prefix -sequence as a string. If it returns nil, the key binding is -ignored by which-key. Otherwise it should a cons cell of the same -form. To leave the key binding unchanged simply return the -original cons cell. Here's an example - -\(defun my-filter \(cell prefix\) - \(if \(and \(string-equal prefix \"SPC\"\) - \(string-equal \(car cell\) \"?\"\)\) - \(cons \"?\" \"NEW DESCRIPTION\") - cell\)\) - -\(setq which-key-binding-filter-function 'my-filter\)" - :group 'which-key - :type 'function) + :type '(alist :key-type (alist :key-type regexp :value-type regexp) + :value-type (alist :key-type regexp :value-type regexp))) + +(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-highlighted-command-list '() "A list of strings and/or cons cells used to highlight certain @@ -557,13 +584,8 @@ used.") (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-key-based-description-replacement-alist '() - "New version of -`which-key-key-based-description-replacement-alist'. Use -`which-key-add-key-based-replacements' or -`which-key-add-major-mode-key-based-replacements' to set this -variable.") +(defvar which-key--last-replace-key nil) +(defvar which-key--prefix-title-alist 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") @@ -758,6 +780,14 @@ bottom." alist) (t (cons (cons keys value) alist))))) +(defun which-key-replace-key-binding (match-cons replace-cons) + (lambda (key-binding) + (cons + (replace-regexp-in-string + (car match-cons) (car replace-cons) (car key-binding)) + (replace-regexp-in-string + (cdr match-cons) (cdr replace-cons) (cdr key-binding))))) + ;;;###autoload (defun which-key-add-key-based-replacements (key-sequence replacement &rest more) "Replace the description of KEY-SEQUENCE with REPLACEMENT. @@ -778,15 +808,18 @@ replacements are added to `which-key-key-based-description-replacement-alist'." ;; TODO: Make interactive (while key-sequence - (setq which-key-key-based-description-replacement-alist - (which-key--add-key-val-to-alist - which-key-key-based-description-replacement-alist - key-sequence replacement "key-based")) + (push (cons (cons (format "\\`%s\\'" key-sequence) nil) + (cons nil (or (car-safe replacement) replacement))) + which-key-replacement-alist) + (when (consp replacement) + (push (cons key-sequence (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) +(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 @@ -794,16 +827,26 @@ 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 (cdr (assq mode which-key-key-based-description-replacement-alist)))) + (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 - (setq mode-alist (which-key--add-key-val-to-alist - mode-alist key-sequence replacement - (format "key-based-%s" mode))) + (push (cons (cons (format "\\`%s\\'" key-sequence) nil) + (cons nil (or (car-safe replacement) replacement))) + mode-alist) + (when (consp replacement) + (push (cons key-sequence (cdr-safe replacement)) + title-mode-alist)) (setq key-sequence (pop more) replacement (pop more))) - (if (assq mode which-key-key-based-description-replacement-alist) - (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) - (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) -(put 'which-key-add-major-mode-key-based-replacements 'lisp-indent-function 'defun) + (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 @@ -1233,20 +1276,40 @@ local bindings coming first. Within these categories order using (defsubst which-key--butlast-string (str) (mapconcat #'identity (butlast (split-string str)) " ")) -(defun which-key--maybe-replace (string repl-alist &optional literal) - "Perform replacements on STRING. -REPL-ALIST is an alist where the car of each element is the text -to replace and the cdr is the replacement text. Unless LITERAL is -non-nil regexp is used in the replacements. Whether or not a -replacement occurs return the new STRING." - (save-match-data - (let ((new-string string) - case-fold-search) - (dolist (repl repl-alist) - (when (string-match (car repl) new-string) - (setq new-string - (replace-match (cdr repl) t literal new-string)))) - new-string))) +(defun which-key--replacement-test (alist-key key) + (when (and (consp alist-key) + (or (null (car alist-key)) + (string-match-p (car alist-key) (car key))) + (or (null (cdr alist-key)) + (string-match-p (cdr alist-key) (cdr key)))) + (setq which-key--last-replace-key alist-key))) + +(defun which-key--maybe-replace (key-binding) + (setq which-key--last-replace-key nil) + (let* ((mode-alist (assq major-mode which-key-replacement-alist)) + (mode-res (when mode-alist + (assoc-default + key-binding mode-alist 'which-key--replacement-test))) + (res (or mode-res + (assoc-default + key-binding which-key-replacement-alist + 'which-key--replacement-test)))) + (cond ((null res) key-binding) + ((consp res) + (cons + (cond ((and (car res) (car which-key--last-replace-key)) + (replace-regexp-in-string + (car which-key--last-replace-key) + (car res) (car key-binding) t)) + ((car res) (car res)) + (t (car key-binding))) + (cond ((and (cdr res) (cdr which-key--last-replace-key)) + (replace-regexp-in-string + (cdr which-key--last-replace-key) + (cdr res) (cdr key-binding) t)) + ((cdr res) (cdr res)) + (t (cdr key-binding))))) + ((functionp res) (funcall res key-binding))))) (defsubst which-key--current-key-list (&optional key-str) (append (listify-key-sequence which-key--current-prefix) @@ -1261,38 +1324,22 @@ replacement occurs return the new STRING." (current-local-map) (kbd (which-key--current-key-string (car keydesc)))) (intern (cdr keydesc)))) -(defun which-key--maybe-replace-key-based (string keys &optional title) - "KEYS is a string produced by `key-description' -and STRING is the description that is possibly replaced using the -`which-key-key-based-description-replacement-alist'. Whether or -not a replacement occurs return the new STRING." - (let* ((alist which-key-key-based-description-replacement-alist) - (str-res (assoc-string keys alist)) - (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc-string keys mode-alist))) - tmp-res) - (setq tmp-res - (cond (mode-res (cdr mode-res)) - (str-res (cdr str-res)) - (t string))) - (cond ((and (consp tmp-res) title) - (cdr tmp-res)) - ((consp tmp-res) - (car tmp-res)) - (t tmp-res)))) - (defun which-key--maybe-get-prefix-title (keys) "KEYS is a string produced by `key-description'. A title is possibly returned using -`which-key-key-based-description-replacement-alist'. An empty -stiring is returned if no title exists." +`which-key--prefix-title-alist'. An empty stiring is returned if +no title exists." (cond ((not (string-equal keys "")) - (let* ((repl-res (which-key--maybe-replace-key-based "" keys t)) + (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 (repl-res repl-res) + (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)) @@ -1396,23 +1443,20 @@ alists. Returns a list (key separator description)." (propertize which-key-separator 'face 'which-key-separator-face)) (local-map (current-local-map))) (mapcar - (lambda (key-desc-cons) - (let* ((key (car key-desc-cons)) - (orig-desc (cdr key-desc-cons)) + (lambda (key-binding) + (let* ((key (car key-binding)) + (orig-desc (cdr key-binding)) (group (which-key--group-p orig-desc)) (keys (which-key--current-key-string key)) (local (eq (which-key--safe-lookup-key local-map (kbd keys)) (intern orig-desc))) (hl-face (which-key--highlight-face orig-desc)) - (key (which-key--maybe-replace - key which-key-key-replacement-alist)) - (desc (which-key--maybe-replace - orig-desc which-key-description-replacement-alist)) - (desc (which-key--maybe-replace-key-based desc keys)) - (key-w-face (which-key--propertize-key key)) - (desc-w-face (which-key--propertize-description - desc group local hl-face orig-desc))) - (list key-w-face sep-w-face desc-w-face))) + (key-binding (which-key--maybe-replace (cons keys orig-desc)))) + (list (which-key--propertize-key + (car (last (split-string (car key-binding) " ")))) + sep-w-face + (which-key--propertize-description + (cdr key-binding) group local hl-face orig-desc)))) unformatted))) (defun which-key--get-keymap-bindings (keymap &optional filter) @@ -1502,13 +1546,6 @@ alists. Returns a list (key separator description)." "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-binding-filter-function - (setq unformatted - (delq nil (mapcar - (lambda (cell) - (funcall which-key-binding-filter-function - cell (which-key--current-key-string))) - unformatted)))) (when which-key-sort-order (setq unformatted (sort unformatted which-key-sort-order))) commit 17f4b0069273f9c9877dc079e5cf49ed9cb4d278 Author: Justin Burkett Date: Sun Nov 6 12:50:55 2016 -0500 Move sort after filter op in --get-formatted-key-bindings diff --git a/which-key.el b/which-key.el index 2a37da3c89b..4f77379f451 100644 --- a/which-key.el +++ b/which-key.el @@ -1502,9 +1502,6 @@ alists. Returns a list (key separator description)." "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))) (when which-key-binding-filter-function (setq unformatted (delq nil (mapcar @@ -1512,6 +1509,9 @@ BUFFER that follow the key sequence KEY-SEQ." (funcall which-key-binding-filter-function cell (which-key--current-key-string))) unformatted)))) + (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 commit 4b01b44c6718168be9553043124c3efd766abbc1 Author: Justin Burkett Date: Mon Oct 31 13:56:57 2016 -0400 Update comment in --show-buffer-side-window for prior change diff --git a/which-key.el b/which-key.el index c6bf5b5de9f..2a37da3c89b 100644 --- a/which-key.el +++ b/which-key.el @@ -990,21 +990,9 @@ call signature in different emacs versions" (window-height . (lambda (w) (fit-window-to-buffer w nil 1))) (side . ,which-key-side-window-location) (slot . ,which-key-side-window-slot))))) - ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' - ;; were added in Emacs 24.3 - - ;; If two side windows exist in the same side, `display-buffer-in-side-window' - ;; will use on of them, which isn't desirable. `display-buffer-in-major-side-window' - ;; will pop a new window, so we use that. - ;; +-------------------------+ +-------------------------+ - ;; | regular window | | regular window | - ;; | | +------------+------------+ - ;; +------------+------------+ --> | side-win 1 | side-win 2 | - ;; | side-win 1 | side-win 2 | |------------+------------| - ;; | | | | which-key window | - ;; +------------+------------+ +------------+------------+ - ;; (display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist)) - ;; side defaults to bottom + ;; 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 commit fc7482e4a2063697738a405686ebc62d87697ab8 Author: Justin Burkett Date: Mon Oct 31 13:48:14 2016 -0400 Remove use of display-buffer-in-major-side-window According to emacs bug #24828, this is an internal function and should not be used. Following the advice from that report, switch to display-buffer-in-side-window and add an option for the user to specify the slot value for that function. Fixes #146 diff --git a/which-key.el b/which-key.el index d97e885cc7e..c6bf5b5de9f 100644 --- a/which-key.el +++ b/which-key.el @@ -230,6 +230,20 @@ location is tried." (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. @@ -966,13 +980,16 @@ call signature in different emacs versions" "Show which-key buffer when popup type is side-window." (let* ((height (car act-popup-dim)) (width (cdr act-popup-dim)) - (side which-key-side-window-location) (alist (if which-key-allow-imprecise-window-fit `((window-width . ,(which-key--text-width-to-total width)) - (window-height . ,height)) - '((window-width . which-key--fit-buffer-to-window-horizontally) - (window-height . (lambda (w) (fit-window-to-buffer w nil 1))))))) + (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))))) ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' ;; were added in Emacs 24.3 @@ -992,11 +1009,11 @@ call signature in different emacs versions" ((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-major-side-window which-key--buffer side 0 alist)) + (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-major-side-window which-key--buffer side 0 alist))))) + (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." commit ee121d08bf3b505f0dc2e5a6a8a425f1c3943fad Author: Justin Burkett Date: Sat Oct 29 09:15:03 2016 -0400 Add which-key-binding-filter-function Can be used to arbitrarily manipulate key bindings, including deleting them, before they are processed by which-key. See docstring for usage. Fixes #152 https://github.com/syl20bnr/spacemacs/issues/7582 diff --git a/which-key.el b/which-key.el index 70372675ce9..d97e885cc7e 100644 --- a/which-key.el +++ b/which-key.el @@ -149,6 +149,25 @@ This is a list of lists for replacing descriptions." :group 'which-key :type '(alist :key-type regexp :value-type string)) +(defcustom which-key-binding-filter-function nil + "Optional function to use to filter key bindings before they +are processed by which-key. The function should accept a cons +cell of the form (\"KEY\" . \"BINDING\") and the current prefix +sequence as a string. If it returns nil, the key binding is +ignored by which-key. Otherwise it should a cons cell of the same +form. To leave the key binding unchanged simply return the +original cons cell. Here's an example + +\(defun my-filter \(cell prefix\) + \(if \(and \(string-equal prefix \"SPC\"\) + \(string-equal \(car cell\) \"?\"\)\) + \(cons \"?\" \"NEW DESCRIPTION\") + cell\)\) + +\(setq which-key-binding-filter-function 'my-filter\)" + :group 'which-key + :type 'function) + (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 @@ -1481,6 +1500,13 @@ BUFFER that follow the key sequence KEY-SEQ." (when which-key-sort-order (setq unformatted (sort unformatted which-key-sort-order))) + (when which-key-binding-filter-function + (setq unformatted + (delq nil (mapcar + (lambda (cell) + (funcall which-key-binding-filter-function + cell (which-key--current-key-string))) + unformatted)))) (which-key--format-and-replace unformatted))) ;;; Functions for laying out which-key buffer pages commit 5abc8cfd33f7ad03ceb3fe7b35fbcdc732c0193a Author: Justin Burkett Date: Sat Oct 29 08:34:42 2016 -0400 Add sort option -prefix-then-key-order-reverse Fixes #145 diff --git a/which-key.el b/which-key.el index c17a1c7a3eb..70372675ce9 100644 --- a/which-key.el +++ b/which-key.el @@ -1176,6 +1176,16 @@ coming before a prefix. Within these categories order using (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 commit c678b9370682c55e73b1157929e97edce44fe398 Author: Justin Burkett Date: Sat Oct 29 08:33:55 2016 -0400 Add global option for how to sort case which-key-sort-uppercase-first (default t) See #145 diff --git a/which-key.el b/which-key.el index b85d8158428..c17a1c7a3eb 100644 --- a/which-key.el +++ b/which-key.el @@ -268,6 +268,13 @@ information." :group 'which-key :type 'function) +(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 @@ -1085,13 +1092,14 @@ width) in lines and characters respectively." ;;; Sorting functions (defun which-key--string< (a b &optional alpha) - (if alpha - (let ((da (downcase a)) - (db (downcase b))) - (if (string-equal da db) - (not (string-lessp a b)) - (string-lessp da db))) - (string-lessp a b))) + (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 @@ -1116,7 +1124,7 @@ width) in lines and characters respectively." ((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) - (string-lessp a b))) + (which-key--string< a b alpha))) ((or asp? bsp?) asp?) ((and a1? b1?) (which-key--string< a b alpha)) ((or a1? b1?) a1?) @@ -1127,9 +1135,9 @@ width) in lines and characters respectively." ((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) - (string-lessp a b))) + (which-key--string< a b alpha))) ((or apr? bpr?) apr?) - (t (string-lessp a b)))))) + (t (which-key--string< a b alpha)))))) (defsubst which-key-key-order-alpha (acons bcons) "Order key descriptions A and B. @@ -1462,7 +1470,7 @@ 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 (lambda (a b) (funcall which-key-sort-order a b))))) + (sort unformatted which-key-sort-order))) (which-key--format-and-replace unformatted))) ;;; Functions for laying out which-key buffer pages commit a6a9f352e735f3d7faf45d0e8f23f3a346c04f9c Merge: 5b3614643e3 431f29aee44 Author: Justin Burkett Date: Mon Oct 17 21:35:49 2016 -0400 Merge pull request #149 from rdotdk/patch-1 fix link commit 431f29aee44b983bbe7beb9e4e0542dabd7bf57b Author: Hariharan R Date: Sun Oct 16 02:18:23 2016 -0400 fix link diff --git a/README.org b/README.org index 31a3186bd27..059fe296ca8 100644 --- a/README.org +++ b/README.org @@ -12,7 +12,7 @@ the popup will look like are included below. =which-key= started as a rewrite of to a certain extent. ** Table of Contents :TOC@4: - - [[#which-key-][which-key ]] + - [[#which-key][which-key]] - [[#introduction][Introduction]] - [[#install][Install]] - [[#melpa][MELPA]] commit 5b3614643e3e8a5815505e24fb34ee57a360442b Author: Justin Burkett Date: Wed Oct 5 16:32:29 2016 -0400 Fix test for recent prefix-name change diff --git a/which-key-tests.el b/which-key-tests.el index e5c8c4a05f0..e620c3ae3e1 100644 --- a/which-key-tests.el +++ b/which-key-tests.el @@ -30,7 +30,7 @@ (ert-deftest which-key-test-prefix-declaration () "Test `which-key-declare-prefixes' and `which-key-declare-prefixes-for-mode'. See Bug #109." - (let* (test-mode which-key-prefix-name-alist which-key-prefix-title-alist) + (let* (test-mode which-key-key-based-description-replacement-alist) (which-key-declare-prefixes "SPC C-c" '("complete" . "complete title") "SPC C-k" "cancel") @@ -38,20 +38,12 @@ "C-c C-c" '("complete" . "complete title") "C-c C-k" "cancel") (should (equal - (assoc-string "SPC C-k" which-key-prefix-name-alist) + (assoc-string "SPC C-k" which-key-key-based-description-replacement-alist) '("SPC C-k" . "cancel"))) (should (equal (assoc-string - "C-c C-c" (cdr (assq 'test-mode which-key-prefix-name-alist))) - '("C-c C-c" . "complete"))) - (pp which-key-prefix-title-alist) - (should (equal - (assoc-string "SPC C-k" which-key-prefix-title-alist) - '("SPC C-k" . "cancel"))) - (should (equal - (assoc-string - "C-c C-c" (cdr (assq 'test-mode which-key-prefix-title-alist))) - '("C-c C-c" . "complete title"))))) + "C-c C-c" (cdr (assq 'test-mode which-key-key-based-description-replacement-alist))) + '("C-c C-c" . ("complete" . "complete title")))))) (provide 'which-key-tests) ;;; which-key-tests.el ends here commit fe73d0849c68b72f96b71f63e6b6e745ac18e50f Author: Justin Burkett Date: Wed Oct 5 14:54:49 2016 -0400 Make 458c8d9 backwards compatible The prefix titles need to be in cons cells to stay consistent with how they were used before. diff --git a/which-key.el b/which-key.el index ff9e46b5841..b85d8158428 100644 --- a/which-key.el +++ b/which-key.el @@ -703,9 +703,9 @@ bottom." (defun which-key--add-key-val-to-alist (alist key value &optional alist-name) "Internal function to add (KEY . VALUE) to ALIST." - (when (or (not (stringp key)) (not (or (stringp value) (listp value)))) + (when (or (not (stringp key)) (not (or (stringp value) (consp value)))) (error "which-key: Error %s (key) should be a string and %s (value) should\ - be a string or list of strings." + be a string or cons of two strings." key value)) (let ((keys (key-description (kbd key)))) (cond ((null alist) (list (cons keys value))) @@ -726,9 +726,9 @@ may either be a string, as in \(which-key-add-key-based-replacements \"C-x 1\" \"maximize\"\) -or a list of two strings as in +or a cons of two strings as in -\(which-key-add-key-based-replacements \"C-x 8\" '(\"unicode\" \"Unicode keys\")\) +\(which-key-add-key-based-replacements \"C-x 8\" '(\"unicode\" . \"Unicode keys\")\) In the second case, the second string is used to provide a longer name for the keys under a prefix. @@ -1233,9 +1233,9 @@ not a replacement occurs return the new STRING." (cond (mode-res (cdr mode-res)) (str-res (cdr str-res)) (t string))) - (cond ((and (listp tmp-res) title) - (nth 1 tmp-res)) - ((listp tmp-res) + (cond ((and (consp tmp-res) title) + (cdr tmp-res)) + ((consp tmp-res) (car tmp-res)) (t tmp-res)))) commit 94b2c7b884b7841aebf1db6aaecc8f20be34dc49 Author: Justin Burkett Date: Wed Oct 5 14:42:10 2016 -0400 Move a function for the compiler diff --git a/which-key.el b/which-key.el index 681a2eb0fc7..ff9e46b5841 100644 --- a/which-key.el +++ b/which-key.el @@ -1219,6 +1219,26 @@ replacement occurs return the new STRING." (current-local-map) (kbd (which-key--current-key-string (car keydesc)))) (intern (cdr keydesc)))) +(defun which-key--maybe-replace-key-based (string keys &optional title) + "KEYS is a string produced by `key-description' +and STRING is the description that is possibly replaced using the +`which-key-key-based-description-replacement-alist'. Whether or +not a replacement occurs return the new STRING." + (let* ((alist which-key-key-based-description-replacement-alist) + (str-res (assoc-string keys alist)) + (mode-alist (assq major-mode alist)) + (mode-res (when mode-alist (assoc-string keys mode-alist))) + tmp-res) + (setq tmp-res + (cond (mode-res (cdr mode-res)) + (str-res (cdr str-res)) + (t string))) + (cond ((and (listp tmp-res) title) + (nth 1 tmp-res)) + ((listp tmp-res) + (car tmp-res)) + (t tmp-res)))) + (defun which-key--maybe-get-prefix-title (keys) "KEYS is a string produced by `key-description'. A title is possibly returned using @@ -1244,26 +1264,6 @@ stiring is returned if no title exists." which-key--current-show-keymap-name) (t ""))) -(defun which-key--maybe-replace-key-based (string keys &optional title) - "KEYS is a string produced by `key-description' -and STRING is the description that is possibly replaced using the -`which-key-key-based-description-replacement-alist'. Whether or -not a replacement occurs return the new STRING." - (let* ((alist which-key-key-based-description-replacement-alist) - (str-res (assoc-string keys alist)) - (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc-string keys mode-alist))) - tmp-res) - (setq tmp-res - (cond (mode-res (cdr mode-res)) - (str-res (cdr str-res)) - (t string))) - (cond ((and (listp tmp-res) title) - (nth 1 tmp-res)) - ((listp tmp-res) - (car tmp-res)) - (t tmp-res)))) - (defun which-key--propertize-key (key) "Add a face to KEY. If KEY contains any \"special keys\" defined in commit 458c8d97fb03e926422516ea79198ee18a75dd18 Author: Justin Burkett Date: Wed Oct 5 14:24:11 2016 -0400 Consolidate prefix names and key-based replacements Make obsolete several redundant functions, the most important of which is which-key-declare-prefixes. This is just an alias for which-key-add-key-based-replacements now. The additional functionality that declare-prefixes had (for declaring prefix titles) is now rolled into the add-key-based-replacements function. See that functions doc string. diff --git a/which-key.el b/which-key.el index 61ef9014a8a..681a2eb0fc7 100644 --- a/which-key.el +++ b/which-key.el @@ -525,20 +525,8 @@ used.") `which-key-add-major-mode-key-based-replacements' to set this variable.") -(defvar which-key-prefix-name-alist '() - "An alist with elements of the form (key-sequence . prefix-name). -key-sequence is a sequence of the sort produced by applying -`key-description' to create a canonical version of the key -sequence. prefix-name is a string.") - -(defvar which-key-prefix-title-alist '() - "An alist with elements of the form (key-sequence . prefix-title). -key-sequence is a sequence of the sort produced by applying -`key-description' to create a canonical version of the key -sequence. prefix-title is a string. The title is displayed -alongside the actual current key sequence when -`which-key-show-prefix' is set to either top or echo.") - +(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 @@ -715,13 +703,14 @@ bottom." (defun which-key--add-key-val-to-alist (alist key value &optional alist-name) "Internal function to add (KEY . VALUE) to ALIST." - (when (or (not (stringp key)) (not (stringp value))) - (error "which-key: Error %s (key) and %s (value) should be strings" + (when (or (not (stringp key)) (not (or (stringp value) (listp value)))) + (error "which-key: Error %s (key) should be a string and %s (value) should\ + be a string or list of strings." key value)) (let ((keys (key-description (kbd key)))) (cond ((null alist) (list (cons keys value))) ((assoc-string keys alist) - (when (not (string-equal (cdr (assoc-string keys alist)) value)) + (when (not (equal (cdr (assoc-string keys alist)) value)) (when which-key-is-verbose (message "which-key: changing %s name from %s to %s in the %s alist" key (cdr (assoc-string keys alist)) value alist-name)) @@ -732,11 +721,19 @@ bottom." ;;;###autoload (defun which-key-add-key-based-replacements (key-sequence replacement &rest more) "Replace the description of KEY-SEQUENCE with REPLACEMENT. -Both KEY-SEQUENCE and REPLACEMENT should be strings. For Example, +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\"\) -MORE allows you to specifcy additional KEY REPL pairs. All +or a list of two strings as in + +\(which-key-add-key-based-replacements \"C-x 8\" '(\"unicode\" \"Unicode keys\")\) + +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 @@ -768,77 +765,21 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) (put 'which-key-add-major-mode-key-based-replacements 'lisp-indent-function 'defun) -;;;###autoload -(defun which-key-add-prefix-title (key-seq-str title &optional force) - "Deprecated in favor of `which-key-declare-prefixes'. - -Add title for KEY-SEQ-STR given by TITLE. FORCE, if non-nil, will -add the new title even if one already exists. KEY-SEQ-STR should -be a key sequence string suitable for `kbd' and TITLE should be a -string." - (let ((keys (key-description (kbd key-seq-str)))) - (if (and (null force) - (assoc-string keys which-key-prefix-title-alist)) - (when which-key-is-verbose - (message "which-key: Prefix title not added. A title exists for this prefix.")) - (push (cons keys title) which-key-prefix-title-alist)))) - -;;;###autoload -(defun which-key-declare-prefixes (key-sequence name &rest more) - "Name the KEY-SEQUENCE prefix NAME. -KEY-SEQUENCE should be a string, acceptable to `kbd'. NAME can be -a string or a cons cell of two strings. In the first case, the -string is used as both the name and the title (the title is -displayed in the echo area only). For Example, +(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") -\(which-key-declare-prefixes \"C-x 8\" \"unicode\"\) +(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") -or - -\(which-key-declare-prefixes \"C-x 8\" (\"unicode\" . \"Unicode Chararcters\")\) - -MORE allows you to specifcy additional KEY-SEQUENCE NAME pairs. -All names are added to `which-key-prefix-names-alist' and titles -to `which-key-prefix-title-alist'." - (while key-sequence - (let ((name (if (consp name) (car name) name)) - (title (if (consp name) (cdr name) name))) - (setq which-key-prefix-name-alist - (which-key--add-key-val-to-alist - which-key-prefix-name-alist key-sequence name "prefix-name") - which-key-prefix-title-alist - (which-key--add-key-val-to-alist - which-key-prefix-title-alist key-sequence title "prefix-title"))) - (setq key-sequence (pop more) name (pop more)))) -(put 'which-key-declare-prefixes 'lisp-indent-function 'defun) - -;;;###autoload -(defun which-key-declare-prefixes-for-mode (mode key-sequence name &rest more) - "Functions like `which-key-declare-prefixes'. -The difference is that MODE specifies the `major-mode' that must -be active for KEY-SEQUENCE and NAME (MORE contains -addition KEY-SEQUENCE NAME pairs) to apply." - (when (not (symbolp mode)) - (error "MODE should be a symbol corresponding to a value of major-mode")) - (let ((mode-name-alist (cdr (assq mode which-key-prefix-name-alist))) - (mode-title-alist (cdr (assq mode which-key-prefix-title-alist)))) - (while key-sequence - (let ((name (if (consp name) (car name) name)) - (title (if (consp name) (cdr name) name))) - (setq mode-name-alist (which-key--add-key-val-to-alist - mode-name-alist key-sequence name - (format "prefix-name-%s" mode)) - mode-title-alist (which-key--add-key-val-to-alist - mode-title-alist key-sequence title - (format "prefix-name-%s" mode)))) - (setq key-sequence (pop more) name (pop more))) - (if (assq mode which-key-prefix-name-alist) - (setcdr (assq mode which-key-prefix-name-alist) mode-name-alist) - (push (cons mode mode-name-alist) which-key-prefix-name-alist)) - (if (assq mode which-key-prefix-title-alist) - (setcdr (assq mode which-key-prefix-title-alist) mode-title-alist) - (push (cons mode mode-title-alist) which-key-prefix-title-alist)))) -(put 'which-key-declare-prefixes-for-mode 'lisp-indent-function 'defun) +(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. @@ -1278,36 +1219,18 @@ replacement occurs return the new STRING." (current-local-map) (kbd (which-key--current-key-string (car keydesc)))) (intern (cdr keydesc)))) -(defun which-key--maybe-replace-prefix-name (keys desc) - "KEYS is a list of keys produced by `listify-key-sequences' and -`key-description'. DESC is the description that is possibly -replaced using the `which-key-prefix-name-alist'. Whether or not -a replacement occurs return the new STRING." - (let* ((alist which-key-prefix-name-alist) - (res (assoc-string keys alist)) - (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist - (assoc-string keys mode-alist)))) - (cond (mode-res (cdr mode-res)) - (res (cdr res)) - (t desc)))) - (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." +A title is possibly returned using +`which-key-key-based-description-replacement-alist'. An empty +stiring is returned if no title exists." (cond ((not (string-equal keys "")) - (let* ((alist which-key-prefix-title-alist) - (res (assoc-string keys alist)) - (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist - (assoc-string keys mode-alist))) + (let* ((repl-res (which-key--maybe-replace-key-based "" keys t)) (binding (key-binding (kbd keys))) (alternate (when (and binding (symbolp binding)) (symbol-name binding)))) - (cond (mode-res (cdr mode-res)) - (res (cdr res)) + (cond (repl-res repl-res) ((and (eq which-key-show-prefix 'echo) alternate) alternate) ((and (member which-key-show-prefix '(bottom top)) @@ -1321,7 +1244,7 @@ An empty stiring is returned if no title exists." which-key--current-show-keymap-name) (t ""))) -(defun which-key--maybe-replace-key-based (string keys) +(defun which-key--maybe-replace-key-based (string keys &optional title) "KEYS is a string produced by `key-description' and STRING is the description that is possibly replaced using the `which-key-key-based-description-replacement-alist'. Whether or @@ -1329,10 +1252,17 @@ not a replacement occurs return the new STRING." (let* ((alist which-key-key-based-description-replacement-alist) (str-res (assoc-string keys alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc-string keys mode-alist)))) - (cond (mode-res (cdr mode-res)) - (str-res (cdr str-res)) - (t string)))) + (mode-res (when mode-alist (assoc-string keys mode-alist))) + tmp-res) + (setq tmp-res + (cond (mode-res (cdr mode-res)) + (str-res (cdr str-res)) + (t string))) + (cond ((and (listp tmp-res) title) + (nth 1 tmp-res)) + ((listp tmp-res) + (car tmp-res)) + (t tmp-res)))) (defun which-key--propertize-key (key) "Add a face to KEY. @@ -1437,9 +1367,6 @@ alists. Returns a list (key separator description)." (desc (which-key--maybe-replace orig-desc which-key-description-replacement-alist)) (desc (which-key--maybe-replace-key-based desc keys)) - (desc (if group - (which-key--maybe-replace-prefix-name keys desc) - desc)) (key-w-face (which-key--propertize-key key)) (desc-w-face (which-key--propertize-description desc group local hl-face orig-desc))) commit d939e06fdac9b158e06a8633186ffa41e396e659 Author: Justin Burkett Date: Tue Oct 4 16:48:40 2016 -0400 Fix -maybe-get-prefix-title use of key-binding key-binding doesn't work with all forms of key strings. See #143 diff --git a/which-key.el b/which-key.el index 6e92281fd31..61ef9014a8a 100644 --- a/which-key.el +++ b/which-key.el @@ -1303,7 +1303,7 @@ An empty stiring is returned if no title exists." (mode-alist (assq major-mode alist)) (mode-res (when mode-alist (assoc-string keys mode-alist))) - (binding (key-binding keys)) + (binding (key-binding (kbd keys))) (alternate (when (and binding (symbolp binding)) (symbol-name binding)))) (cond (mode-res (cdr mode-res)) commit c493e0b4bb53c524d99c6ad071ba0a22259f8f38 Author: Justin Burkett Date: Sun Sep 11 15:58:53 2016 -0400 Resize popup when frame resized Fixes #139 diff --git a/which-key.el b/which-key.el index 4ef640887a6..6e92281fd31 100644 --- a/which-key.el +++ b/which-key.el @@ -516,6 +516,7 @@ used.") (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-key-based-description-replacement-alist '() "New version of @@ -620,6 +621,8 @@ problems at github. If DISABLE is non-nil disable support." (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 @@ -629,6 +632,8 @@ problems at github. If DISABLE is non-nil disable support." (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 () @@ -909,6 +914,15 @@ total height." 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 () @@ -940,6 +954,12 @@ total height." (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) @@ -1109,11 +1129,11 @@ width) in lines and characters respectively." (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--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--width-or-percentage-to-width + 1.0))) which-key-unicode-correction)))) (defun which-key--frame-max-dimensions () @@ -1491,7 +1511,7 @@ alists. Returns a list (key separator description)." ((string-match-p ignore-keys-regexp key)) ((and which-key--current-prefix (string-match (format "^%s[ \t]\\([^ \t]+\\)[ \t]+$" - key-str-qt) key)) + key-str-qt) key)) (unless (assoc-string (match-string 1 key) bindings) (push (cons (match-string 1 key) binding) bindings))) ((and which-key--current-prefix commit ad9b0e43bc07b44094686ed521a4e107aa8efd2e Merge: df90df61b3a 1c4bea2d094 Author: Justin Burkett Date: Wed Aug 31 19:55:26 2016 -0400 Merge pull request #137 from tarsius/outlines Follow conventions for section headers commit df90df61b3afb5ec7d5113d6226f5e2e91668f9f Merge: 1eace34a1f5 fe21ce6f0b5 Author: Justin Burkett Date: Wed Aug 31 19:55:03 2016 -0400 Merge pull request #136 from tarsius/fixup Move definition of which-key--local-binding-p commit 1c4bea2d094bcd2e37c0729b61ecedfe7e9ad884 Author: Jonas Bernoulli Date: Thu Sep 1 01:26:10 2016 +0200 Follow conventions for section headers Doing so allows the use of `outline-minor-mode' makes it possible to navigate sections similarly to how that is done in `org-mode'. diff --git a/which-key.el b/which-key.el index 0c98a9ab2cc..c5ffc35f43e 100644 --- a/which-key.el +++ b/which-key.el @@ -48,6 +48,8 @@ (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 @@ -388,7 +390,8 @@ by `key-description'." (defvar which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized.") -;; Faces +;;;; Faces + (defgroup which-key-faces nil "Faces for which-key-mode" :group 'which-key @@ -435,7 +438,8 @@ and it matches a string in `which-key-highlighted-command-list'." "Face for special keys (SPC, TAB, RET)" :group 'which-key-faces) -;; Custom popup +;;;; 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 @@ -474,7 +478,8 @@ to a non-nil value for the execution of a command. Like this "History of keymap selections in functions like `which-key-show-keymap'.") -;; Internal Vars +;;; Internal Vars + (defvar which-key--buffer nil "Internal: Holds reference to which-key buffer.") (defvar which-key--timer nil @@ -534,9 +539,9 @@ alongside the actual current key sequence when `which-key-show-prefix' is set to either top or echo.") -;; Third-party library support +;;; Third-party library support +;;;; Evil -;; 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 @@ -552,7 +557,8 @@ valid keys missing and it might be showing some invalid keys." :group 'which-key :type 'boolean) -;; God-mode +;;;;; 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 @@ -584,6 +590,8 @@ problems at github. If DISABLE is non-nil disable support." '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." @@ -661,8 +669,7 @@ starter kit for example." (setq which-key-key-replacement-alist (delete '("right" . "→") which-key-key-replacement-alist))) -;; Default configuration functions for use by users. Should be the "best" -;; configurations +;;; Default configuration functions for use by users. ;;;###autoload (defun which-key-setup-side-window-right () @@ -699,7 +706,7 @@ bottom." (setq which-key-popup-type 'minibuffer which-key-show-prefix 'left)) -;; Helper functions to modify replacement lists. +;;; Helper functions to modify replacement lists. (defun which-key--add-key-val-to-alist (alist key value &optional alist-name) "Internal function to add (KEY . VALUE) to ALIST." @@ -838,8 +845,7 @@ If AT-ROOT is non-nil the binding is also placed at the root of MAP." (which-key-define-key-recursively df key def t))) map)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for computing window sizes +;;; Functions for computing window sizes (defun which-key--text-width-to-total (text-width) "Convert window text-width to window total-width. @@ -903,8 +909,7 @@ total height." height-or-percentage (round (* height-or-percentage (window-total-height (frame-root-window)))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Show/hide which-key buffer +;;; Show/hide which-key buffer (defun which-key--hide-popup () "This function is called to hide the which-key buffer." @@ -1063,8 +1068,7 @@ call signature in different emacs versions" (set-frame-size (window-frame window) frame-width frame-height) window))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Max dimension of available window functions +;;; Max dimension of available window functions (defun which-key--popup-max-dimensions () "Dimesion functions should return the maximum possible (height @@ -1104,10 +1108,12 @@ width) in lines and characters respectively." ;; 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--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 () @@ -1115,8 +1121,7 @@ width) in lines and characters respectively." width) in lines and characters respectively." (cons which-key-frame-max-height which-key-frame-max-width)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Sorting functions +;;; Sorting functions (defun which-key--string< (a b &optional alpha) (if alpha @@ -1217,8 +1222,7 @@ local bindings coming first. Within these categories order using (and aloc? (not bloc?)) (which-key-key-order acons bcons)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for retrieving and formatting keys +;;; 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." @@ -1486,7 +1490,8 @@ alists. Returns a list (key separator description)." ((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)) + (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) binding) bindings))) ((and which-key--current-prefix @@ -1513,8 +1518,7 @@ BUFFER that follow the key sequence KEY-SEQ." (sort unformatted (lambda (a b) (funcall which-key-sort-order a b))))) (which-key--format-and-replace unformatted))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for laying out which-key buffer pages +;;; Functions for laying out which-key buffer pages (defun which-key--normalize-columns (columns) "Pad COLUMNS to the same length using empty strings." @@ -1821,8 +1825,7 @@ enough space based on your settings and frame size." prefix-keys) (with-no-warnings (set-temporary-overlay-map (which-key--get-popup-map)))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; paging functions +;;; Paging functions ;;;###autoload (defun which-key-reload-key-sequence (key-seq) @@ -1962,8 +1965,7 @@ prefix) if `which-key-use-C-h-commands' is non nil." (which-key-inhibit t)) (if cmd (funcall cmd) (which-key-turn-page 0)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Update +;;; Update (defun which-key--any-match-p (regexps string) "Non-nil if any of REGEXPS match STRING." @@ -2184,7 +2186,7 @@ Finally, show the buffer." (not which-key--using-show-keymap)) (which-key--hide-popup))))) -;; Timers +;;; Timers (defun which-key--start-timer (&optional delay secondary) "Activate idle timer to trigger `which-key--update'." @@ -2216,7 +2218,7 @@ Finally, show the buffer." (cancel-timer which-key--paging-timer) (which-key--start-timer)))))) -;; backport some functions for 24.3 +;;; backport some functions for 24.3 ;; found at https://github.com/Lindydancer/andersl-old-emacs-support/blob/master/andersl-old-emacs-support.el (unless (fboundp 'frame-fringe-width) commit fe21ce6f0b58e0ba5c729fdd0afc3093fe8ff6b0 Author: Jonas Bernoulli Date: Wed Aug 31 14:41:41 2016 +0200 Move definition of which-key--local-binding-p It has to be defined after the inline functions which it uses. diff --git a/which-key.el b/which-key.el index 0c98a9ab2cc..90aea83f7b4 100644 --- a/which-key.el +++ b/which-key.el @@ -1202,11 +1202,6 @@ coming before a prefix. Within these categories order using (and (not apref?) bpref?) (which-key-key-order acons bcons)))) -(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-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 @@ -1254,6 +1249,11 @@ replacement occurs return the new STRING." (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-replace-prefix-name (keys desc) "KEYS is a list of keys produced by `listify-key-sequences' and `key-description'. DESC is the description that is possibly commit 1eace34a1f5b780a30797976d0cfec5936048b7b Author: Justin Burkett Date: Wed Aug 17 11:17:45 2016 -0400 Version 1.1.15 diff --git a/which-key.el b/which-key.el index 114b04dae3a..0c98a9ab2cc 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.14 +;; Version: 1.1.15 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit b7cce2d0a7eaa3092c96bd211c743af6891e3feb Author: Justin Burkett Date: Wed Aug 17 11:17:16 2016 -0400 Add note about setting delay to zero diff --git a/README.org b/README.org index fc5ad99e99b..31a3186bd27 100644 --- a/README.org +++ b/README.org @@ -386,7 +386,8 @@ 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. + ;; 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 diff --git a/which-key.el b/which-key.el index ccac5ce50f8..114b04dae3a 100644 --- a/which-key.el +++ b/which-key.el @@ -54,7 +54,9 @@ :prefix "which-key-") (defcustom which-key-idle-delay 1.0 - "Delay (in seconds) for which-key buffer to popup." + "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) commit 06444f300ecb767b42ad09f0e2d35e098dd1402d Author: Justin Burkett Date: Wed Aug 17 11:11:56 2016 -0400 Fix minibuffer echo not displaying See #133 diff --git a/which-key.el b/which-key.el index 5d08278db82..ccac5ce50f8 100644 --- a/which-key.el +++ b/which-key.el @@ -1657,20 +1657,21 @@ is the width of the live window." (defun which-key--echo (text) "Echo TEXT to minibuffer without logging." - (let* ((minibuffer (eq which-key-popup-type 'minibuffer)) - ;; (delay (if minibuffer - ;; 0.2 - ;; (+ (or echo-keystrokes 0) 0.001))) - message-log-max) - (unless minibuffer (message "%s" text)) - - ;; Caused some completion commands in the minibuffer to be overwritten, so - ;; disable the hack for now - - ;; (run-with-idle-timer - ;; delay nil (lambda () (let (message-log-max) - ;; (message "%s" text)))) - )) + (let (message-log-max) + (message "%s" text))) + +;; Caused some completion commands in the minibuffer to be overwritten, so +;; disable the hack for now +;; (defun which-key--echo (text) +;; "Echo TEXT to minibuffer without logging." +;; (let* ((minibuffer (eq which-key-popup-type 'minibuffer)) +;; (delay (if minibuffer +;; 0.2 +;; (+ (or echo-keystrokes 0) 0.001))) +;; message-log-max) +;; (run-with-idle-timer +;; delay nil (lambda () (let (message-log-max) +;; (message "%s" text)))))) (defun which-key--next-page-hint (prefix-keys) "Return string for next page hint." commit 979b98429047bec063a22fbd9f6cdf3e2b44aaed Author: Justin Burkett Date: Thu Jul 28 09:20:20 2016 -0400 Version 1.1.14 Tagged wrong commit diff --git a/which-key.el b/which-key.el index d7cee3ff4ea..5d08278db82 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.12 +;; Version: 1.1.14 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit c03f179e253cfce18c21c5eb1a0cde2e2bdbaf43 Author: Justin Burkett Date: Thu Jul 28 09:17:19 2016 -0400 Disable hack for echo area Seems to cause more problems (like completion commands sometimes being overwritten) than it solves. diff --git a/which-key.el b/which-key.el index f77d7256cf2..d7cee3ff4ea 100644 --- a/which-key.el +++ b/which-key.el @@ -1656,18 +1656,21 @@ is the width of the live window." (setcar (cdr (assq 'which-key-mode minor-mode-alist)) which-key--lighter-backup))) (defun which-key--echo (text) - "Echo TEXT to minibuffer without logging. -Slight delay gets around evil functions that clear the echo -area." + "Echo TEXT to minibuffer without logging." (let* ((minibuffer (eq which-key-popup-type 'minibuffer)) - (delay (if minibuffer - 0.2 - (+ (or echo-keystrokes 0) 0.001))) + ;; (delay (if minibuffer + ;; 0.2 + ;; (+ (or echo-keystrokes 0) 0.001))) message-log-max) (unless minibuffer (message "%s" text)) - (run-with-idle-timer - delay nil (lambda () (let (message-log-max) - (message "%s" text)))))) + + ;; Caused some completion commands in the minibuffer to be overwritten, so + ;; disable the hack for now + + ;; (run-with-idle-timer + ;; delay nil (lambda () (let (message-log-max) + ;; (message "%s" text)))) + )) (defun which-key--next-page-hint (prefix-keys) "Return string for next page hint." commit b7e1906dd6fb8b1dc03685229f956a21a5ded269 Author: Justin Burkett Date: Wed Jul 27 09:22:38 2016 -0400 Fix Makefile diff --git a/Makefile b/Makefile index 34574e36025..facb1f80b4b 100644 --- a/Makefile +++ b/Makefile @@ -15,4 +15,5 @@ test: elpa elpa: $(ELPA_DIR) $(ELPA_DIR): Cask $(CASK) install + mkdir -p $(ELPA_DIR) touch $@ commit eb4a6f6e251cf0e34f2d7f988591dea194b4012f Author: Justin Burkett Date: Sat Jul 9 15:25:50 2016 -0400 Add allow-imprecise-window-fit option Possible fix for #130 When enabled this option avoids the use of fit-window-to-buffer to resize the popup. My profiling suggested that emacs was spending a lot of time in this function (and hanging sometimes) with different fonts. I noticed this with Roboto Mono on MSWindows, which should explain #130. diff --git a/which-key.el b/which-key.el index 280212bba3c..f77d7256cf2 100644 --- a/which-key.el +++ b/which-key.el @@ -233,6 +233,15 @@ a percentage out of the frame's height." :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 @@ -959,11 +968,17 @@ 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) +(defun which-key--show-buffer-side-window (act-popup-dim) "Show which-key buffer when popup type is side-window." - (let* ((side which-key-side-window-location) - (alist '((window-width . which-key--fit-buffer-to-window-horizontally) - (window-height . (lambda (w) (fit-window-to-buffer w nil 1)))))) + (let* ((height (car act-popup-dim)) + (width (cdr act-popup-dim)) + (side which-key-side-window-location) + (alist + (if which-key-allow-imprecise-window-fit + `((window-width . ,(which-key--text-width-to-total width)) + (window-height . ,height)) + '((window-width . which-key--fit-buffer-to-window-horizontally) + (window-height . (lambda (w) (fit-window-to-buffer w nil 1))))))) ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' ;; were added in Emacs 24.3 commit 9ec4b6a258c99bff307cfbde6b183634210d6363 Author: Justin Burkett Date: Wed Jul 6 15:16:40 2016 -0400 Explicitly set tab-width when collecting bindings For some reason indent-tabs-mode doesn't use tabs with strange tab-widths. See https://github.com/syl20bnr/spacemacs/issues/6497 diff --git a/which-key.el b/which-key.el index c9cd9e3b3fc..280212bba3c 100644 --- a/which-key.el +++ b/which-key.el @@ -1429,8 +1429,9 @@ alists. Returns a list (key separator description)." (ignore-keys-regexp "mouse-\\|wheel-\\|remap\\|drag-\\|scroll-bar\\|select-window\\|switch-frame\\|-state") (ignore-sections-regexp "\\(Key translations\\|Function key map translations\\|Input decoding map translations\\)")) (with-temp-buffer - (let ((indent-tabs-mode t)) - (describe-buffer-bindings buffer which-key--current-prefix)) + (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) commit 71b0b83a27b9622a39cda4a238815036f83b94e6 Author: Justin Burkett Date: Tue Jul 5 09:05:47 2016 -0400 Fix previous commit diff --git a/which-key.el b/which-key.el index 324778841a7..c9cd9e3b3fc 100644 --- a/which-key.el +++ b/which-key.el @@ -2132,7 +2132,7 @@ Finally, show the buffer." (or (null which-key-inhibit-regexps) (not (which-key--any-match-p - which-key-allow-regexps (key-description prefix-keys)))) + 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 commit adfcd0e73b6950bccf52d3c2f5b57e4a498fbfc3 Author: Justin Burkett Date: Tue Jul 5 08:58:40 2016 -0400 Add whitelist and blacklist options which-key-allow-regexps is a list of regexps that allow the popup when one is matched which-key-inhibit-regexps inhibits the popup when one regexp matches The string matched against is the current key sequence as produced by key-description. Fixes #129 diff --git a/which-key.el b/which-key.el index 12c798727b4..324778841a7 100644 --- a/which-key.el +++ b/which-key.el @@ -356,6 +356,23 @@ The delay time is effectively added to the normal :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)) + ;; Hooks (defvar which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized.") @@ -1926,6 +1943,14 @@ prefix) if `which-key-use-C-h-commands' is non nil." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update +(defun which-key--any-match-p (regexps string) + "Non-nil if any of REGEXPS match STRING." + (let (match) + (dolist (regexp regexps) + (when (string-match-p regexp string) + (setq match t))) + match)) + (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) @@ -2101,6 +2126,13 @@ Finally, show the buffer." (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-allow-regexps (key-description prefix-keys)))) ;; Do not display the popup if a command is currently being ;; executed (or (and which-key-allow-evil-operators commit 9184b1bcbf316e8d619d72ae140efa48c5e6595d Author: Justin Burkett Date: Fri Jun 17 08:42:18 2016 -0400 Remove setup code It's no longer necessary and makes changing echo-keystrokes annoying. diff --git a/which-key.el b/which-key.el index 6f2792ee90c..12c798727b4 100644 --- a/which-key.el +++ b/which-key.el @@ -455,8 +455,6 @@ to a non-nil value for the execution of a command. Like this "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--is-setup nil - "Internal: Non-nil if which-key buffer has been setup.") (defvar which-key--frame nil "Internal: Holds reference to which-key frame. Used when `which-key-popup-type' is frame.") @@ -574,7 +572,9 @@ problems at github. If DISABLE is non-nil disable support." (if which-key-mode (progn (setq which-key--echo-keystrokes-backup echo-keystrokes) - (unless which-key--is-setup (which-key--setup)) + (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 @@ -611,17 +611,6 @@ problems at github. If DISABLE is non-nil disable support." (setq-local show-trailing-whitespace nil) (run-hooks 'which-key-init-buffer-hook)))) -(defun which-key--setup () - "Initial setup for which-key. -Reduce `echo-keystrokes' if necessary (it will interfere if it's -set too high) and setup which-key buffer." - (when (or (eq which-key-show-prefix 'echo) - (eq which-key-popup-type 'minibuffer)) - (which-key--setup-echo-keystrokes)) - ;; (which-key--setup-undo-key) - (which-key--init-buffer) - (setq which-key--is-setup t)) - (defun which-key--setup-echo-keystrokes () "Reduce `echo-keystrokes' if necessary (it will interfere if it's set too high)." @@ -2125,7 +2114,7 @@ Finally, show the buffer." 'which-key-delay-functions (key-description prefix-keys) (length prefix-keys)))) - (sit-for delay-time t)) + (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)) commit ff66d8abc702a061065ffd540d2db9aee592ba56 Author: Justin Burkett Date: Thu Jun 16 11:01:53 2016 -0400 Make current-prefix nil when not showing popup diff --git a/which-key.el b/which-key.el index 55721a8129f..6f2792ee90c 100644 --- a/which-key.el +++ b/which-key.el @@ -893,6 +893,7 @@ total height." "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 commit 6adadec740b64bb33153a197222708ece353ad1f Author: Justin Burkett Date: Thu Jun 16 10:03:51 2016 -0400 Use sit-for instead of timer for delay functions diff --git a/which-key.el b/which-key.el index 1e2437cb5d3..55721a8129f 100644 --- a/which-key.el +++ b/which-key.el @@ -344,17 +344,17 @@ See http://www.gnu.org/software/emacs/manual/html_node/emacs/Modifier-Keys.html" (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 a single argument -which is the current key sequence as produced by -`key-description'. 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. +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 (vector integer))) + :type '(repeat function)) ;; Hooks (defvar which-key-init-buffer-hook '() @@ -485,7 +485,6 @@ used.") (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--delayed-timer nil) (defvar which-key-key-based-description-replacement-alist '() "New version of @@ -900,8 +899,6 @@ total height." which-key--current-show-keymap-name nil which-key--prior-show-keymap-args nil which-key--on-last-page nil) - (when (timerp which-key--delayed-timer) - (cancel-timer which-key--delayed-timer)) (when (and which-key-idle-secondary-delay which-key--secondary-timer-active) (which-key--start-timer)) @@ -2075,10 +2072,10 @@ Finally, show the buffer." (which-key--create-pages formatted-keys)) (which-key--show-page 0))))) -(defun which-key--update (&optional delayed) +(defun which-key--update () "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." (let ((prefix-keys (this-single-command-keys)) - skip) + delay-time) ;; (when (> (length prefix-keys) 0) ;; (message "key: %s" (key-description prefix-keys))) ;; (when (> (length prefix-keys) 0) @@ -2105,14 +2102,6 @@ Finally, show the buffer." (eq this-command 'god-mode-self-insert)) (setq prefix-keys (when which-key--god-mode-key-string (kbd which-key--god-mode-key-string)))) - (when (and which-key-delay-functions - (> (length prefix-keys) 0) - (not delayed) - (setq skip (run-hook-with-args-until-success - 'which-key-delay-functions - (key-description prefix-keys)))) - (setq which-key--delayed-timer - (run-with-idle-timer skip nil #'which-key--update t))) (cond ((and (> (length prefix-keys) 0) (or (keymapp (key-binding prefix-keys)) ;; Some keymaps are stored here like iso-transl-ctl-x-8-map @@ -2122,7 +2111,6 @@ Finally, show the buffer." (keymapp (which-key--safe-lookup-key function-key-map prefix-keys))) (not which-key-inhibit) - (not skip) ;; Do not display the popup if a command is currently being ;; executed (or (and which-key-allow-evil-operators @@ -2131,21 +2119,25 @@ Finally, show the buffer." (bound-and-true-p god-local-mode) (eq this-command 'god-mode-self-insert)) (null this-command))) - (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))) + (when (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 t)) + (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-operator-state-maps (bound-and-true-p evil-state) (eq evil-state 'operator) - (not which-key--using-show-operator-keymap) - (not skip)) + (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) - (not skip)) + (not which-key--using-show-keymap)) (which-key--hide-popup))))) ;; Timers commit c2fb61f2f8bb8b51900e0dd55f70c5e7efa949b8 Author: Justin Burkett Date: Tue Jun 14 21:45:10 2016 -0400 Fix arg to which-key-delay-functions diff --git a/which-key.el b/which-key.el index 79858459e80..1e2437cb5d3 100644 --- a/which-key.el +++ b/which-key.el @@ -2109,7 +2109,8 @@ Finally, show the buffer." (> (length prefix-keys) 0) (not delayed) (setq skip (run-hook-with-args-until-success - 'which-key-delay-functions prefix-keys))) + 'which-key-delay-functions + (key-description prefix-keys)))) (setq which-key--delayed-timer (run-with-idle-timer skip nil #'which-key--update t))) (cond ((and (> (length prefix-keys) 0) commit e4d61490e8c9bb271855ef0fdd1887433d1ad525 Author: Justin Burkett Date: Tue Jun 14 21:42:34 2016 -0400 Redesign delayed keys implementation Everything is controlled through which-key-delay-functions now. Ref #128 diff --git a/which-key.el b/which-key.el index 79f7a2bdf03..79858459e80 100644 --- a/which-key.el +++ b/which-key.el @@ -341,20 +341,21 @@ See http://www.gnu.org/software/emacs/manual/html_node/emacs/Modifier-Keys.html" :group 'which-key :type 'boolean) -(defcustom which-key-delayed-prefixes nil - "A list of key sequences (in the form of vectors of events) -that should not pop up the which-key buffer after -`which-key-idle-delay' but after `which-key-idle-delay' + -`which-key-delayed-prefixes-delay'." +(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 a single argument +which is the current key sequence as produced by +`key-description'. 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 (vector integer))) -(defcustom which-key-delayed-prefixes-delay 1 - "When `which-key-delayed-prefixes' is non-nil delay which-key -popup by this many seconds after `which-key-idle-delay'." - :group 'which-key - :type 'integer) - ;; Hooks (defvar which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized.") @@ -2104,15 +2105,13 @@ Finally, show the buffer." (eq this-command 'god-mode-self-insert)) (setq prefix-keys (when which-key--god-mode-key-string (kbd which-key--god-mode-key-string)))) - (when (and which-key-delayed-prefixes - which-key-delayed-prefixes-delay + (when (and which-key-delay-functions (> (length prefix-keys) 0) (not delayed) - (member prefix-keys which-key-delayed-prefixes)) + (setq skip (run-hook-with-args-until-success + 'which-key-delay-functions prefix-keys))) (setq which-key--delayed-timer - (run-with-idle-timer which-key-delayed-prefixes-delay nil - #'which-key--update t)) - (setq skip t)) + (run-with-idle-timer skip nil #'which-key--update t))) (cond ((and (> (length prefix-keys) 0) (or (keymapp (key-binding prefix-keys)) ;; Some keymaps are stored here like iso-transl-ctl-x-8-map @@ -2138,12 +2137,14 @@ Finally, show the buffer." ((and which-key-show-operator-state-maps (bound-and-true-p evil-state) (eq evil-state 'operator) - (not which-key--using-show-operator-keymap)) + (not which-key--using-show-operator-keymap) + (not skip)) (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)) + (not which-key--using-show-keymap) + (not skip)) (which-key--hide-popup))))) ;; Timers commit 12d2266d9d7ba24a1f0f9cad54b0153f061bef06 Author: Justin Burkett Date: Thu Jun 9 22:39:47 2016 -0400 Fix bug in previous commit diff --git a/which-key.el b/which-key.el index 0175d3367e1..79f7a2bdf03 100644 --- a/which-key.el +++ b/which-key.el @@ -899,7 +899,8 @@ total height." which-key--current-show-keymap-name nil which-key--prior-show-keymap-args nil which-key--on-last-page nil) - (cancel-timer which-key--delayed-timer) + (when (timerp which-key--delayed-timer) + (cancel-timer which-key--delayed-timer)) (when (and which-key-idle-secondary-delay which-key--secondary-timer-active) (which-key--start-timer)) commit 322cda0e7865f90493ed0337182c2d9fe51a66b4 Author: Justin Burkett Date: Thu Jun 9 22:37:11 2016 -0400 Introduce delayed prefixes One version of idea in #128. This design is subject to change. diff --git a/which-key.el b/which-key.el index abc9e36e679..0175d3367e1 100644 --- a/which-key.el +++ b/which-key.el @@ -341,6 +341,20 @@ See http://www.gnu.org/software/emacs/manual/html_node/emacs/Modifier-Keys.html" :group 'which-key :type 'boolean) +(defcustom which-key-delayed-prefixes nil + "A list of key sequences (in the form of vectors of events) +that should not pop up the which-key buffer after +`which-key-idle-delay' but after `which-key-idle-delay' + +`which-key-delayed-prefixes-delay'." + :group 'which-key + :type '(repeat (vector integer))) + +(defcustom which-key-delayed-prefixes-delay 1 + "When `which-key-delayed-prefixes' is non-nil delay which-key +popup by this many seconds after `which-key-idle-delay'." + :group 'which-key + :type 'integer) + ;; Hooks (defvar which-key-init-buffer-hook '() "Hook run when which-key buffer is initialized.") @@ -470,6 +484,7 @@ used.") (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--delayed-timer nil) (defvar which-key-key-based-description-replacement-alist '() "New version of @@ -884,6 +899,7 @@ total height." which-key--current-show-keymap-name nil which-key--prior-show-keymap-args nil which-key--on-last-page nil) + (cancel-timer which-key--delayed-timer) (when (and which-key-idle-secondary-delay which-key--secondary-timer-active) (which-key--start-timer)) @@ -2057,9 +2073,10 @@ Finally, show the buffer." (which-key--create-pages formatted-keys)) (which-key--show-page 0))))) -(defun which-key--update () +(defun which-key--update (&optional delayed) "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." - (let ((prefix-keys (this-single-command-keys))) + (let ((prefix-keys (this-single-command-keys)) + skip) ;; (when (> (length prefix-keys) 0) ;; (message "key: %s" (key-description prefix-keys))) ;; (when (> (length prefix-keys) 0) @@ -2086,6 +2103,15 @@ Finally, show the buffer." (eq this-command 'god-mode-self-insert)) (setq prefix-keys (when which-key--god-mode-key-string (kbd which-key--god-mode-key-string)))) + (when (and which-key-delayed-prefixes + which-key-delayed-prefixes-delay + (> (length prefix-keys) 0) + (not delayed) + (member prefix-keys which-key-delayed-prefixes)) + (setq which-key--delayed-timer + (run-with-idle-timer which-key-delayed-prefixes-delay nil + #'which-key--update t)) + (setq skip t)) (cond ((and (> (length prefix-keys) 0) (or (keymapp (key-binding prefix-keys)) ;; Some keymaps are stored here like iso-transl-ctl-x-8-map @@ -2095,6 +2121,7 @@ Finally, show the buffer." (keymapp (which-key--safe-lookup-key function-key-map prefix-keys))) (not which-key-inhibit) + (not skip) ;; Do not display the popup if a command is currently being ;; executed (or (and which-key-allow-evil-operators commit 13316578c8483740ecfe97f9f069fc364e4f97d9 Author: Justin Burkett Date: Fri May 27 09:35:27 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index 45a4d632e18..abc9e36e679 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.11 +;; Version: 1.1.12 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit d031bad7b6042006c9706fb8bd467edacf3fb435 Author: Justin Burkett Date: Fri May 27 09:31:35 2016 -0400 Fix performance issue with secondary timer The secondary timer option was restarting the timer every time through the update function, which caused the cpu to max out. Adds a flag so that the timer is only restarted when necessary. Fixes #126 diff --git a/which-key.el b/which-key.el index 464c9e82345..45a4d632e18 100644 --- a/which-key.el +++ b/which-key.el @@ -436,6 +436,8 @@ to a non-nil value for the execution of a command. Like this "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--is-setup nil @@ -882,7 +884,8 @@ total height." which-key--current-show-keymap-name nil which-key--prior-show-keymap-args nil which-key--on-last-page nil) - (when which-key-idle-secondary-delay + (when (and which-key-idle-secondary-delay + which-key--secondary-timer-active) (which-key--start-timer)) (cl-case which-key-popup-type ;; Not necessary to hide minibuffer @@ -2101,8 +2104,9 @@ Finally, show the buffer." (eq this-command 'god-mode-self-insert)) (null this-command))) (which-key--create-buffer-and-show prefix-keys) - (when which-key-idle-secondary-delay - (which-key--start-timer which-key-idle-secondary-delay))) + (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-operator-state-maps (bound-and-true-p evil-state) (eq evil-state 'operator) @@ -2116,9 +2120,10 @@ Finally, show the buffer." ;; Timers -(defun which-key--start-timer (&optional delay) +(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 commit 169c1ad72506fcfe3ced439c3f2e42a87ea67556 Author: Justin Burkett Date: Thu May 26 11:19:02 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index 92789e40fba..464c9e82345 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.10 +;; Version: 1.1.11 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 8fee7c168eb3635287557b8810edaf7b4113bd7d Author: Justin Burkett Date: Thu May 26 11:16:43 2016 -0400 Fix --echo when echo-keystrokes nil diff --git a/which-key.el b/which-key.el index 477df09a9bf..92789e40fba 100644 --- a/which-key.el +++ b/which-key.el @@ -1619,7 +1619,9 @@ is the width of the live window." Slight delay gets around evil functions that clear the echo area." (let* ((minibuffer (eq which-key-popup-type 'minibuffer)) - (delay (if minibuffer 0.2 (+ echo-keystrokes 0.001))) + (delay (if minibuffer + 0.2 + (+ (or echo-keystrokes 0) 0.001))) message-log-max) (unless minibuffer (message "%s" text)) (run-with-idle-timer commit 3018a537f5cd7f0c726e7fb6125e6442de9a0efc Author: Justin Burkett Date: Tue May 24 21:37:52 2016 -0400 Remove some unused code in comments diff --git a/which-key.el b/which-key.el index b47b05825cd..477df09a9bf 100644 --- a/which-key.el +++ b/which-key.el @@ -434,8 +434,6 @@ to a non-nil value for the execution of a command. Like this ;; Internal Vars (defvar which-key--buffer nil "Internal: Holds reference to which-key buffer.") -;; (defvar which-key--window nil -;; "Internal: Holds reference to which-key window.") (defvar which-key--timer nil "Internal: Holds reference to open window timer.") (defvar which-key--paging-timer nil @@ -603,7 +601,6 @@ set too high) and setup which-key buffer." (when (or (eq which-key-show-prefix 'echo) (eq which-key-popup-type 'minibuffer)) (which-key--setup-echo-keystrokes)) - ;; (which-key--check-key-based-alist) ;; (which-key--setup-undo-key) (which-key--init-buffer) (setq which-key--is-setup t)) @@ -611,17 +608,12 @@ set too high) and setup which-key buffer." (defun which-key--setup-echo-keystrokes () "Reduce `echo-keystrokes' if necessary (it will interfere if it's set too high)." - (let (;(previous echo-keystrokes) - ) - (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)) - ;; (message "which-key: echo-keystrokes changed from %s to %s" - ;; previous echo-keystrokes) - ))) + (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 @@ -635,36 +627,6 @@ starter kit for example." (setq which-key-key-replacement-alist (delete '("right" . "→") which-key-key-replacement-alist))) -;; (defun which-key--check-key-based-alist () -;; "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'" -;; (let ((alist which-key-key-based-description-replacement-alist) -;; old-style res) -;; (dolist (cns alist) -;; (cond ((listp (car cns)) -;; (push cns res)) -;; ((stringp (car cns)) -;; (setq old-style t) -;; (push (cons (listify-key-sequence (kbd (car cns))) (cdr cns)) res)) -;; ((symbolp (car cns)) -;; (let (new-mode-alist) -;; (dolist (cns2 (cdr cns)) -;; (cond ((listp (car cns2)) -;; (push cns2 new-mode-alist)) -;; ((stringp (car cns2)) -;; (setq old-style t) -;; (push (cons (listify-key-sequence (kbd (car cns2))) (cdr cns2)) -;; new-mode-alist)))) -;; (push (cons (car cns) new-mode-alist) res))) -;; (t (message "which-key: there's a problem with the \ -;; entry %s in which-key-key-based-replacement-alist" cns)))) -;; (setq which-key-key-based-description-replacement-alist res) -;; (when old-style -;; (message "which-key: \ -;; `which-key-key-based-description-replacement-alist' has changed format and you\ -;; seem to be using the old format. Please use the functions \ -;; `which-key-add-key-based-replacements' and \ -;; `which-key-add-major-mode-key-based-replacements' instead.")))) - ;; Default configuration functions for use by users. Should be the "best" ;; configurations commit e8a66637c7c1d0a86499e537977e345f3188f4cb Author: Justin Burkett Date: Tue May 24 12:44:50 2016 -0400 Change name of arg in define-key-recursively Also clarify docstring diff --git a/which-key.el b/which-key.el index 2cdf1cb94bb..b47b05825cd 100644 --- a/which-key.el +++ b/which-key.el @@ -832,10 +832,10 @@ addition KEY-SEQUENCE NAME pairs) to apply." (push (cons mode mode-title-alist) which-key-prefix-title-alist)))) (put 'which-key-declare-prefixes-for-mode 'lisp-indent-function 'defun) -(defun which-key-define-key-recursively (map key def &optional recursing) +(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. -RECURSING is for internal use." - (when recursing (define-key map key def)) +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) commit c6ad06c03d5adaa148472d53da47a2ea7749b182 Author: Justin Burkett Date: Mon May 16 21:25:05 2016 -0400 New screenshots diff --git a/img/which-key-bottom.png b/img/which-key-bottom.png index d7e725b3a22..19f1f521f3b 100644 Binary files a/img/which-key-bottom.png and b/img/which-key-bottom.png differ diff --git a/img/which-key-minibuffer.png b/img/which-key-minibuffer.png index bb5d00bf26b..702e175941e 100644 Binary files a/img/which-key-minibuffer.png and b/img/which-key-minibuffer.png differ diff --git a/img/which-key-right.png b/img/which-key-right.png index 8af4d682e6b..e95d3d069bf 100644 Binary files a/img/which-key-right.png and b/img/which-key-right.png differ commit 1b611e9947140f9c384a31cebbd5f24d106fe059 Author: Justin Burkett Date: Mon May 16 21:18:59 2016 -0400 More cleanup of README diff --git a/README.org b/README.org index d8f5e98546b..fc5ad99e99b 100644 --- a/README.org +++ b/README.org @@ -44,7 +44,6 @@ to a certain extent. - [[#god-mode][God-mode]] - [[#more-examples][More Examples]] - [[#nice-display-with-split-frame][Nice Display with Split Frame]] - - [[#status][Status]] - [[#thanks][Thanks]] ** Install @@ -298,12 +297,6 @@ available options. #+END_SRC *** Paging Options -[Note: This section is out of date given the new =C-h= commands feature -described in the What's New section. I will update it soon.]. -- =C-h= commands! Now =C-h= will prompt you will several options instead of - going directly to the next page. You can (see =which-key-C-h-map=) - This is a fairly substantial change and might introduce a bug or two, so - please report anything you see that is strange and I will try to fix it. 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 @@ -458,10 +451,6 @@ windows. #+CAPTION: which-key in a frame with 2 vertical splits [[./img/which-key-bottom-split.png]] -** Status -It requires testing on different platforms with different configurations, which -is beyond my capabilities. The default configuration has been reasonably stable -for me. ** Thanks Special thanks to - @bmag for helping with the initial development and finding many commit 02ee845072bb9e93adb3f6c1c1f672fe8bbe6ba9 Author: Justin Burkett Date: Mon May 16 21:15:28 2016 -0400 README typo diff --git a/README.org b/README.org index a570592495e..d8f5e98546b 100644 --- a/README.org +++ b/README.org @@ -292,7 +292,7 @@ available options. ;; 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-prefix-then-key-order) +;; (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 commit 642373e356f982605e461157ebc232a6064a06ea Author: Justin Burkett Date: Mon May 16 21:08:18 2016 -0400 Fix comment about special keys in README diff --git a/README.org b/README.org index 5db07c1b6fd..a570592495e 100644 --- a/README.org +++ b/README.org @@ -73,16 +73,8 @@ 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. -By default which-key makes substitutions for text all with the aim of saving -space. The most noticeable are the "special keys" like SPC, TAB, RET, etc. This -can be turned off (see [[#other-options][Other Options]]), but the default is to -truncate these keys to one character and display them using =:inverse-video= -(flips foreground and background colors). You can see the effect in the -screenshots. - -There are other substitution abilities included, which are quite flexible +There are many substitution abilities included, which are quite flexible (ability to use regexp for example). This makes which-key very customizable. -This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacemacs]]. *** Side Window Bottom Option Popup side window on bottom. This is the current default. To restore this setup use commit 0c32f52bfce89850cb5a4aeb97b1d11be038ff17 Author: Justin Burkett Date: Mon May 16 21:06:23 2016 -0400 Update docs for new sort function diff --git a/README.org b/README.org index 74baeb27811..5db07c1b6fd 100644 --- a/README.org +++ b/README.org @@ -299,6 +299,8 @@ available options. ;; (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-prefix-then-key-order) ;; sort based on the key description ignoring case ;; (setq which-key-sort-order 'which-key-description-order) #+END_SRC diff --git a/which-key.el b/which-key.el index d221c6fdcd2..2cdf1cb94bb 100644 --- a/which-key.el +++ b/which-key.el @@ -245,8 +245,10 @@ a percentage out of the frame's height." are 1. `which-key-key-order': by key (default) -2. `which-key-description-order': by description -3. `which-key-prefix-then-key-order': prefix (no prefix first) then key +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." commit c18ff1c131a33e9d75674dc25b9e54ff88db380f Author: Justin Burkett Date: Mon May 16 15:35:33 2016 -0400 Add which-key-local-then-key-order To use (setq which-key-sort-order 'which-key-local-then-key-order) See #125 diff --git a/which-key.el b/which-key.el index b4458933596..d221c6fdcd2 100644 --- a/which-key.el +++ b/which-key.el @@ -1196,6 +1196,21 @@ coming before a prefix. Within these categories order using (and (not apref?) bpref?) (which-key-key-order acons bcons)))) +(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-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 commit 484f4ff9a733838cda6105a3c02e0ae574ed8697 Author: Justin Burkett Date: Fri May 13 09:05:03 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index 26d3612c84e..b4458933596 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.9 +;; Version: 1.1.10 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 796d0ccefbf8f4c07bf23dff621da56cbbf4ac89 Author: Justin Burkett Date: Thu May 12 08:39:38 2016 -0400 Account for echo-keystrokes = which-key-idle-delay Ref #123 diff --git a/which-key.el b/which-key.el index e0ef45b851c..26d3612c84e 100644 --- a/which-key.el +++ b/which-key.el @@ -68,7 +68,7 @@ this behavior." :type 'float) (defcustom which-key-echo-keystrokes (if (and echo-keystrokes - (> echo-keystrokes + (> (+ echo-keystrokes 0.01) which-key-idle-delay)) (/ (float which-key-idle-delay) 4) echo-keystrokes) commit e151eebebf74b81321d49ea9c120bee149820fa8 Author: Justin Burkett Date: Sat May 7 08:07:55 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index e4c8f714c4a..e0ef45b851c 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.8 +;; Version: 1.1.9 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 7ccae62f0d9bfb551608b91f5db4dd8e7a3410e0 Merge: 9883acc8878 df41a62dc8f Author: Justin Burkett Date: Sat May 7 08:03:05 2016 -0400 Merge pull request #122 from redguardtoo/master tooltip-mode does in exist in emacs-nox #120 commit df41a62dc8f90cbe18ebaddd57e810a16ff0035a Author: Chen Bin Date: Sat May 7 14:19:23 2016 +1000 tooltip-mode does in exist in emacs-nox #120 diff --git a/which-key.el b/which-key.el index 04bb693a880..e4c8f714c4a 100644 --- a/which-key.el +++ b/which-key.el @@ -1354,11 +1354,14 @@ ORIGINAL-DESCRIPTION is the description given by (local 'which-key-local-map-description-face) (t 'which-key-command-description-face)) 'help-echo (cond - ((and (fboundp (intern original-description)) + ((and original-description + (fboundp (intern original-description)) (documentation (intern original-description)) - tooltip-mode) + ;; tooltip-mode doesn't exist in emacs-nox + (boundp 'tooltip-mode) tooltip-mode) (documentation (intern original-description))) - ((and (fboundp (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)) commit 9883acc8878d0b540090ea0199af128a6819b56b Author: Justin Burkett Date: Thu May 5 10:31:45 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index c0bf5eca2be..04bb693a880 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.7 +;; Version: 1.1.8 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit e13a378a9d41f4c902633ba230d968d54433c2c7 Author: Justin Burkett Date: Thu May 5 10:30:44 2016 -0400 Backport two frame width functions for 24.3 support Fixes #119 diff --git a/which-key.el b/which-key.el index 6788d0168af..c0bf5eca2be 100644 --- a/which-key.el +++ b/which-key.el @@ -2161,5 +2161,24 @@ Finally, show the buffer." (cancel-timer which-key--paging-timer) (which-key--start-timer)))))) +;; backport some functions for 24.3 + +;; found at https://github.com/Lindydancer/andersl-old-emacs-support/blob/master/andersl-old-emacs-support.el +(unless (fboundp 'frame-fringe-width) + (defun frame-fringe-width (&optional frame) + "Return fringe width of FRAME in pixels." + (let ((left-pair (assq 'left-fringe (frame-parameters frame))) + (right-pair (assq 'right-fringe (frame-parameters frame)))) + (+ (if left-pair (cdr left-pair) 0) + (if right-pair (cdr right-pair) 0))))) + +(unless (fboundp 'frame-scroll-bar-width) + (defun frame-scroll-bar-width (&optional frame) + "Return scroll bar width of FRAME in pixels." + (let ((pair (assq 'scroll-bar-width (frame-parameters frame)))) + (if pair + (cdr pair) + 0)))) + (provide 'which-key) ;;; which-key.el ends here commit a6397980d55721675998acbd104907436b3a734a Merge: e095d528f73 d905bf65707 Author: Justin Burkett Date: Wed Apr 27 15:04:01 2016 -0400 Merge pull request #116 from cute-jumper/master Fix god mode advice commit d905bf6570797c4c0b711d3b4526c6b622993538 Author: Junpeng Qiu Date: Wed Apr 27 14:45:41 2016 -0400 Fix god mode advice See https://github.com/justbur/emacs-which-key/pull/115 diff --git a/which-key.el b/which-key.el index fcb762809f5..6788d0168af 100644 --- a/which-key.el +++ b/which-key.el @@ -519,12 +519,12 @@ problems at github.") "Holds key string to use for god-mode support.") (defadvice god-mode-lookup-command - (before which-key--god-mode-lookup-command-advice disable) - (setq which-key--god-mode-key-string (ad-get-arg 0))) - -(defadvice god-mode-self-insert - (after which-key--god-mode-self-insert-advice disable) - (which-key--hide-popup)) + (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, @@ -533,21 +533,13 @@ problems at github. If DISABLE is non-nil disable support." (interactive "P") (setq which-key--god-mode-support-enabled (null disable)) (if disable - (progn - (ad-disable-advice - 'god-mode-lookup-command - 'before 'which-key--god-mode-lookup-command-advice) - (ad-disable-advice - 'god-mode-self-insert - 'after 'which-key--god-mode-self-insert-advice)) + (ad-disable-advice + 'god-mode-lookup-command + 'around 'which-key--god-mode-lookup-command-advice) (ad-enable-advice 'god-mode-lookup-command - 'before 'which-key--god-mode-lookup-command-advice) - (ad-enable-advice - 'god-mode-self-insert - 'after 'which-key--god-mode-self-insert-advice)) - (ad-activate 'god-mode-lookup-command) - (ad-activate 'god-mode-self-insert)) + 'around 'which-key--god-mode-lookup-command-advice)) + (ad-activate 'god-mode-lookup-command)) ;;;###autoload (define-minor-mode which-key-mode commit e095d528f732679ce270be3f82d113cc8c82deb2 Merge: 88fd7608c52 cc2a561a16f Author: Justin Burkett Date: Tue Apr 26 14:27:58 2016 -0400 Merge branch 'god-mode' commit cc2a561a16ff8d1206603525343f26854395206c Author: Justin Burkett Date: Tue Apr 26 14:26:25 2016 -0400 Add advice for god-mode support to hide popup The standard way to hide the popup before the command is not working. diff --git a/which-key.el b/which-key.el index 23f71917451..a78d49562a6 100644 --- a/which-key.el +++ b/which-key.el @@ -514,22 +514,36 @@ 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 (before which-key--god-mode-advice disable) +(defadvice god-mode-lookup-command + (before which-key--god-mode-lookup-command-advice disable) (setq which-key--god-mode-key-string (ad-get-arg 0))) +(defadvice god-mode-self-insert + (after which-key--god-mode-self-insert-advice disable) + (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)) - (ad-deactivate 'god-mode-lookup-command) (if disable - (ad-disable-advice 'god-mode-lookup-command - 'before 'which-key--god-mode-advice) - (ad-enable-advice 'god-mode-lookup-command - 'before 'which-key--god-mode-advice)) - (ad-activate 'god-mode-lookup-command)) + (progn + (ad-disable-advice + 'god-mode-lookup-command + 'before 'which-key--god-mode-lookup-command-advice) + (ad-disable-advice + 'god-mode-self-insert + 'after 'which-key--god-mode-self-insert-advice)) + (ad-enable-advice + 'god-mode-lookup-command + 'before 'which-key--god-mode-lookup-command-advice) + (ad-enable-advice + 'god-mode-self-insert + 'after 'which-key--god-mode-self-insert-advice)) + (ad-activate 'god-mode-lookup-command) + (ad-activate 'god-mode-self-insert)) ;;;###autoload (define-minor-mode which-key-mode commit 9a5d4c5b15bf3efd9f3f9875cd2849f222046689 Author: Justin Burkett Date: Tue Apr 26 14:16:08 2016 -0400 Fix minor issues with god-mode support Make sure advice is activated for god-mode-lookup-command Check for null which-key--god-mode-key-string diff --git a/which-key.el b/which-key.el index 1153b072d05..23f71917451 100644 --- a/which-key.el +++ b/which-key.el @@ -523,11 +523,13 @@ 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)) + (ad-deactivate 'god-mode-lookup-command) (if disable (ad-disable-advice 'god-mode-lookup-command 'before 'which-key--god-mode-advice) (ad-enable-advice 'god-mode-lookup-command - 'before 'which-key--god-mode-advice))) + 'before 'which-key--god-mode-advice)) + (ad-activate 'god-mode-lookup-command)) ;;;###autoload (define-minor-mode which-key-mode @@ -2085,7 +2087,8 @@ Finally, show the buffer." (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 (kbd which-key--god-mode-key-string))) + (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 commit 88fd7608c5201b1a36b8eed2e9cc688677e96a77 Author: Justin Burkett Date: Tue Apr 26 11:08:32 2016 -0400 Better default for which-key-echo-keystrokes Fixes #114 diff --git a/which-key.el b/which-key.el index ae58344153c..9ad5f522c96 100644 --- a/which-key.el +++ b/which-key.el @@ -67,7 +67,11 @@ this behavior." :group 'which-key :type 'float) -(defcustom which-key-echo-keystrokes 0 +(defcustom which-key-echo-keystrokes (if (and echo-keystrokes + (> echo-keystrokes + 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 @@ -556,7 +560,7 @@ alongside the actual current key sequence when (defun which-key--setup () "Initial setup for which-key. -Reduce `echo-keystrokes' if necessary (it will interfer if it's +Reduce `echo-keystrokes' if necessary (it will interfere if it's set too high) and setup which-key buffer." (when (or (eq which-key-show-prefix 'echo) (eq which-key-popup-type 'minibuffer)) @@ -567,7 +571,7 @@ set too high) and setup which-key buffer." (setq which-key--is-setup t)) (defun which-key--setup-echo-keystrokes () - "Reduce `echo-keystrokes' if necessary (it will interfer if + "Reduce `echo-keystrokes' if necessary (it will interfere if it's set too high)." (let (;(previous echo-keystrokes) ) commit 137ccbbac7beff6899c694a673cd913a1789ed5a Author: Justin Burkett Date: Tue Apr 26 09:18:48 2016 -0400 Add third-party section to which-key.el diff --git a/which-key.el b/which-key.el index 1504519d856..1153b072d05 100644 --- a/which-key.el +++ b/which-key.el @@ -326,21 +326,6 @@ prefixes in `which-key-paging-prefixes'" "No longer applies. See `which-key-C-h-dispatch'" "2015-12-2") -(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) - (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 @@ -501,6 +486,25 @@ sequence. prefix-title is a string. The title is displayed alongside the actual current key sequence when `which-key-show-prefix' is set to either top or echo.") + +;; 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, commit bfc5c38b6d4de1bfc250b407dc8d99209f424953 Author: Justin Burkett Date: Tue Apr 26 09:18:20 2016 -0400 Add third-party support section to readme diff --git a/README.org b/README.org index f3b29526986..74baeb27811 100644 --- a/README.org +++ b/README.org @@ -13,7 +13,6 @@ to a certain extent. ** Table of Contents :TOC@4: - [[#which-key-][which-key ]] - - [[#whats-new][What's New]] - [[#introduction][Introduction]] - [[#install][Install]] - [[#melpa][MELPA]] @@ -39,6 +38,10 @@ to a certain extent. - [[#method-2-bind-your-own-keys][Method 2: Bind your own keys]] - [[#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]] - [[#status][Status]] @@ -52,7 +55,6 @@ 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) @@ -434,6 +436,24 @@ shown. ;; 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 commit 5284e904cc7e9dc1e5dd57de94f0dd789db74d15 Author: Justin Burkett Date: Tue Apr 26 09:07:12 2016 -0400 Add support for god-mode Needs to be explicitly activated by calling (which-key-enable-god-mode-support) diff --git a/which-key.el b/which-key.el index ae58344153c..1504519d856 100644 --- a/which-key.el +++ b/which-key.el @@ -501,6 +501,30 @@ sequence. prefix-title is a string. The title is displayed alongside the actual current key sequence when `which-key-show-prefix' is set to either top or echo.") +;; 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 (before which-key--god-mode-advice disable) + (setq which-key--god-mode-key-string (ad-get-arg 0))) + +(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 + 'before 'which-key--god-mode-advice) + (ad-enable-advice 'god-mode-lookup-command + 'before 'which-key--god-mode-advice))) + ;;;###autoload (define-minor-mode which-key-mode "Toggle which-key-mode." @@ -2054,6 +2078,10 @@ Finally, show the buffer." (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 (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 @@ -2067,6 +2095,9 @@ Finally, show the buffer." ;; 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))) (which-key--create-buffer-and-show prefix-keys) (when which-key-idle-secondary-delay commit d572f37f21838eb336c1eaf79672a7acb9ff06c0 Author: Justin Burkett Date: Tue Apr 19 08:15:23 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index 6939132cfa9..ae58344153c 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.6 +;; Version: 1.1.7 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 38762c3f909ca39d9f89b76935bf2615a6cae35f Author: Justin Burkett Date: Tue Apr 19 08:14:34 2016 -0400 Use new history var for keymap selection diff --git a/which-key.el b/which-key.el index 54839807a0b..6939132cfa9 100644 --- a/which-key.el +++ b/which-key.el @@ -48,8 +48,6 @@ (defvar golden-ratio-mode) (declare-function evil-get-command-property "ext:evil-common.el") -(defvar variable-name-history nil) - (defgroup which-key nil "Customization options for which-key-mode" :group 'help @@ -438,6 +436,10 @@ 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.") @@ -1923,7 +1925,7 @@ is selected interactively from all available keymaps." (and (boundp m) (keymapp (symbol-value m)) (not (equal (symbol-value m) (make-sparse-keymap))))) - t nil 'variable-name-history)))) + 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 () @@ -1940,7 +1942,7 @@ is selected interactively by mode in `minor-mode-map-alist'." (and (symbol-value (car entry)) (not (equal (cdr entry) (make-sparse-keymap))))) minor-mode-map-alist)) - nil t nil 'variable-name-history)))) + nil t nil 'which-key-keymap-history)))) (which-key--show-keymap (symbol-name mode-sym) (cdr (assq mode-sym minor-mode-map-alist))))) commit a45a4248ca6006c055165f6d2683710cefda6f39 Author: Justin Burkett Date: Sun Apr 17 16:58:15 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index 0bafbf6f829..54839807a0b 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.5 +;; Version: 1.1.6 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 77a559ed31b7245953f745d282f6af5c3971c001 Author: Justin Burkett Date: Sun Apr 17 16:57:26 2016 -0400 Explicitly initialize variable-name-history See #110 diff --git a/which-key.el b/which-key.el index 817a8ba9193..0bafbf6f829 100644 --- a/which-key.el +++ b/which-key.el @@ -46,9 +46,10 @@ (defvar evil-operator-state-map) (defvar evil-motion-state-map) (defvar golden-ratio-mode) -(defvar variable-name-history) (declare-function evil-get-command-property "ext:evil-common.el") +(defvar variable-name-history nil) + (defgroup which-key nil "Customization options for which-key-mode" :group 'help commit e7ce315c371b89ea746617d94c4130abc81ea011 Author: Justin Burkett Date: Sun Apr 17 16:37:26 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index 32a251dfef6..817a8ba9193 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.4 +;; Version: 1.1.5 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 48cbf48d68ed217c08f28f429d71d178017363b8 Author: Justin Burkett Date: Sun Apr 17 16:34:45 2016 -0400 Declare variable-name-history Fixes #110 diff --git a/which-key.el b/which-key.el index 7b8038b0ad1..32a251dfef6 100644 --- a/which-key.el +++ b/which-key.el @@ -46,6 +46,7 @@ (defvar evil-operator-state-map) (defvar evil-motion-state-map) (defvar golden-ratio-mode) +(defvar variable-name-history) (declare-function evil-get-command-property "ext:evil-common.el") (defgroup which-key nil commit 6ac8c56b245ceea1923152de4d7bdbd46b3e5367 Author: Justin Burkett Date: Sun Apr 10 15:07:15 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index ce4dd749dc7..7b8038b0ad1 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.3 +;; Version: 1.1.4 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit d0075fbd74ed52a92f1f1dded45d2487174195bf Author: Justin Burkett Date: Sun Apr 10 15:05:02 2016 -0400 Support key ranges below top level diff --git a/which-key.el b/which-key.el index d0052e38c85..ce4dd749dc7 100644 --- a/which-key.el +++ b/which-key.el @@ -1420,6 +1420,15 @@ alists. Returns a list (key separator description)." (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) 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 binding) bindings)))) ((string-match "^\\([^ \t]+\\|[^ \t]+ \\.\\. [^ \t]+\\)[ \t]+$" key) (unless (assoc-string (match-string 1 key) bindings) (push (cons (match-string 1 key) binding) bindings))))))))) commit 2fef1f73c4f95ad1799dd925b732cc73455def80 Author: Justin Burkett Date: Wed Apr 6 13:53:58 2016 -0400 Add badge diff --git a/README.org b/README.org index 75db6d84623..f3b29526986 100644 --- a/README.org +++ b/README.org @@ -1,5 +1,5 @@ * 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]] +[[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]] ** Introduction =which-key= is a minor mode for Emacs that displays the key bindings following your currently commit c77d75fe9d76aac82492bba447796b52b2266823 Author: Justin Burkett Date: Tue Apr 5 10:12:04 2016 -0400 Trigger travis diff --git a/Cask b/Cask index 60fa07cbdf2..d8171e342fc 100644 --- a/Cask +++ b/Cask @@ -5,3 +5,4 @@ (development (depends-on "ert")) + commit 97c7ab1ba1d6f713a7b2e388db622c0cade5bce2 Author: Justin Burkett Date: Tue Apr 5 10:09:59 2016 -0400 Set up travis diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000000..cdea71fe995 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,26 @@ +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.4-travis + - EVM_EMACS=emacs-24.5-travis + - EVM_EMACS=emacs-git-snapshot-travis + +matrix: + fast_finish: true + allow_failures: + env: + - EVM_EMACS=emacs-git-snapshot-travis + +script: + - emacs --version + - make test diff --git a/Cask b/Cask new file mode 100644 index 00000000000..60fa07cbdf2 --- /dev/null +++ b/Cask @@ -0,0 +1,7 @@ +(source gnu) +(source melpa) + +(package-file "which-key.el") + +(development + (depends-on "ert")) diff --git a/Makefile b/Makefile new file mode 100644 index 00000000000..34574e36025 --- /dev/null +++ b/Makefile @@ -0,0 +1,18 @@ +.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 + touch $@ commit 060c8fe0b1a0390bea018a1694fc59d00fb620f2 Author: Justin Burkett Date: Tue Apr 5 10:06:45 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index 898109f13b9..d0052e38c85 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.1.2 +;; Version: 1.1.3 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 07d649e07753f10752f5b33f72b4445d12b5a64d Author: Justin Burkett Date: Tue Apr 5 10:05:38 2016 -0400 Fix problem where prefix-title-alist was not updated diff --git a/which-key.el b/which-key.el index 891deaaa824..898109f13b9 100644 --- a/which-key.el +++ b/which-key.el @@ -780,7 +780,10 @@ addition KEY-SEQUENCE NAME pairs) to apply." (setq key-sequence (pop more) name (pop more))) (if (assq mode which-key-prefix-name-alist) (setcdr (assq mode which-key-prefix-name-alist) mode-name-alist) - (push (cons mode mode-name-alist) which-key-prefix-name-alist)))) + (push (cons mode mode-name-alist) which-key-prefix-name-alist)) + (if (assq mode which-key-prefix-title-alist) + (setcdr (assq mode which-key-prefix-title-alist) mode-title-alist) + (push (cons mode mode-title-alist) which-key-prefix-title-alist)))) (put 'which-key-declare-prefixes-for-mode 'lisp-indent-function 'defun) (defun which-key-define-key-recursively (map key def &optional recursing) commit 001a458fc62664f9d67fb99b9955d36ed325d706 Author: Justin Burkett Date: Tue Apr 5 10:05:15 2016 -0400 Fix docstring typo diff --git a/which-key.el b/which-key.el index 8c8b3dfb25f..891deaaa824 100644 --- a/which-key.el +++ b/which-key.el @@ -760,7 +760,7 @@ to `which-key-prefix-title-alist'." ;;;###autoload (defun which-key-declare-prefixes-for-mode (mode key-sequence name &rest more) - "Functions like `which-key-declare-prefix-names'. + "Functions like `which-key-declare-prefixes'. The difference is that MODE specifies the `major-mode' that must be active for KEY-SEQUENCE and NAME (MORE contains addition KEY-SEQUENCE NAME pairs) to apply." commit b98616102540365362c4b41edff14d45a6cb9633 Author: Justin Burkett Date: Tue Apr 5 10:04:54 2016 -0400 Add tests diff --git a/which-key-tests.el b/which-key-tests.el new file mode 100644 index 00000000000..e5c8c4a05f0 --- /dev/null +++ b/which-key-tests.el @@ -0,0 +1,57 @@ +;;; which-key-tests.el --- Tests for which-key.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Justin Burkett + +;; Author: Justin Burkett +;; URL: https://github.com/justbur/emacs-which-key + +;; 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 . + +;;; 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* (test-mode which-key-prefix-name-alist which-key-prefix-title-alist) + (which-key-declare-prefixes + "SPC C-c" '("complete" . "complete title") + "SPC C-k" "cancel") + (which-key-declare-prefixes-for-mode 'test-mode + "C-c C-c" '("complete" . "complete title") + "C-c C-k" "cancel") + (should (equal + (assoc-string "SPC C-k" which-key-prefix-name-alist) + '("SPC C-k" . "cancel"))) + (should (equal + (assoc-string + "C-c C-c" (cdr (assq 'test-mode which-key-prefix-name-alist))) + '("C-c C-c" . "complete"))) + (pp which-key-prefix-title-alist) + (should (equal + (assoc-string "SPC C-k" which-key-prefix-title-alist) + '("SPC C-k" . "cancel"))) + (should (equal + (assoc-string + "C-c C-c" (cdr (assq 'test-mode which-key-prefix-title-alist))) + '("C-c C-c" . "complete title"))))) + +(provide 'which-key-tests) +;;; which-key-tests.el ends here commit 4800f339465b4f3a1a2af1ac1a02ca4f92611533 Author: Justin Burkett Date: Tue Apr 5 09:39:20 2016 -0400 Bump version diff --git a/which-key.el b/which-key.el index e17bde7f281..8c8b3dfb25f 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 1.0 +;; Version: 1.1.2 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 20032f52c7b5af3b4db27b7c11a2839026fa816a Author: Justin Burkett Date: Tue Apr 5 09:36:43 2016 -0400 Fix bug in declare-prefixes-for-mode Fixes #109 diff --git a/which-key.el b/which-key.el index 8435d2eb2ec..e17bde7f281 100644 --- a/which-key.el +++ b/which-key.el @@ -747,14 +747,14 @@ MORE allows you to specifcy additional KEY-SEQUENCE NAME pairs. All names are added to `which-key-prefix-names-alist' and titles to `which-key-prefix-title-alist'." (while key-sequence - (let ((-name (if (consp name) (car name) name)) - (-title (if (consp name) (cdr name) name))) + (let ((name (if (consp name) (car name) name)) + (title (if (consp name) (cdr name) name))) (setq which-key-prefix-name-alist (which-key--add-key-val-to-alist - which-key-prefix-name-alist key-sequence -name "prefix-name") + which-key-prefix-name-alist key-sequence name "prefix-name") which-key-prefix-title-alist (which-key--add-key-val-to-alist - which-key-prefix-title-alist key-sequence -title "prefix-title"))) + which-key-prefix-title-alist key-sequence title "prefix-title"))) (setq key-sequence (pop more) name (pop more)))) (put 'which-key-declare-prefixes 'lisp-indent-function 'defun) @@ -767,16 +767,16 @@ addition KEY-SEQUENCE NAME pairs) to apply." (when (not (symbolp mode)) (error "MODE should be a symbol corresponding to a value of major-mode")) (let ((mode-name-alist (cdr (assq mode which-key-prefix-name-alist))) - (mode-title-alist (cdr (assq mode which-key-prefix-title-alist))) - (-name (if (consp name) (car name) name)) - (-title (if (consp name) (cdr name) name))) + (mode-title-alist (cdr (assq mode which-key-prefix-title-alist)))) (while key-sequence - (setq mode-name-alist (which-key--add-key-val-to-alist - mode-name-alist key-sequence -name - (format "prefix-name-%s" mode)) - mode-title-alist (which-key--add-key-val-to-alist - mode-title-alist key-sequence -title - (format "prefix-name-%s" mode))) + (let ((name (if (consp name) (car name) name)) + (title (if (consp name) (cdr name) name))) + (setq mode-name-alist (which-key--add-key-val-to-alist + mode-name-alist key-sequence name + (format "prefix-name-%s" mode)) + mode-title-alist (which-key--add-key-val-to-alist + mode-title-alist key-sequence title + (format "prefix-name-%s" mode)))) (setq key-sequence (pop more) name (pop more))) (if (assq mode which-key-prefix-name-alist) (setcdr (assq mode which-key-prefix-name-alist) mode-name-alist) commit fe56015cb1d8aad9c863d9a017f12ad7e374f132 Author: Justin Burkett Date: Thu Mar 31 16:13:06 2016 -0400 Fix key-chord problem See the note in which-key--update diff --git a/which-key.el b/which-key.el index 2706a99062b..8435d2eb2ec 100644 --- a/which-key.el +++ b/which-key.el @@ -2028,8 +2028,13 @@ Finally, show the buffer." (condition-case nil (let ((rkeys (recent-keys))) (vector 'key-chord - (aref rkeys (- (length rkeys) 2)) - (aref rkeys (- (length rkeys) 1)))) + ;; 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]))))) commit bf4c7d8559715e0fc6d620d4df99209c686c423b Author: Justin Burkett Date: Thu Mar 31 10:51:32 2016 -0400 Support key-chord Fixes #108 diff --git a/which-key.el b/which-key.el index a0f226bb393..2706a99062b 100644 --- a/which-key.el +++ b/which-key.el @@ -2021,6 +2021,18 @@ Finally, show the buffer." ;; (message "key: %s" (key-description prefix-keys))) ;; (when (> (length prefix-keys) 0) ;; (message "key binding: %s" (key-binding prefix-keys))) + ;; Taken from guide-key + (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 + (aref rkeys (- (length rkeys) 2)) + (aref rkeys (- (length rkeys) 1)))) + (error (progn + (message "which-key error in key-chord handling") + [key-chord]))))) (cond ((and (> (length prefix-keys) 0) (or (keymapp (key-binding prefix-keys)) ;; Some keymaps are stored here like iso-transl-ctl-x-8-map commit 3150e7d9a4f4f55be9ee02ddee6a901940f3db13 Author: Justin Burkett Date: Mon Mar 21 22:05:26 2016 -0400 Version 1.0 diff --git a/which-key.el b/which-key.el index 7fec216b9ee..a0f226bb393 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.9 +;; Version: 1.0 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit a571ba2338f570b2738f55f221385404e1d69645 Author: Justin Burkett Date: Mon Mar 21 22:04:53 2016 -0400 Cleanup for 1.0 release diff --git a/README.org b/README.org index b955fbe0b9e..75db6d84623 100644 --- a/README.org +++ b/README.org @@ -1,23 +1,5 @@ * 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]] -** Semi-Recent Changes -- =which-key-special-keys= is now disabled by default. See the docstring for the - old setting. -- =C-h= commands! Now =C-h= will prompt you will several options instead of - going directly to the next page. You can (see =which-key-C-h-map=) - - 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 a fairly substantial change and might introduce a bug or two, so - please report anything you see that is strange and I will try to fix it. -- Use your mouse to hover over commands and the docstring will be displayed in - the echo area or a tooltip, depending on whether or not you're using - =tooltip-mode=. -- The function =which-key-show-top-level= was implemented by @iqbalansari - (thanks!) to show top-level key bindings (those not behind a prefix). You can - use =M-x which-key-show-top-level= to try it and bind it to a key if you like. - It should function just like any other which-key popup once it's called. ** Introduction =which-key= is a minor mode for Emacs that displays the key bindings following your currently @@ -29,19 +11,6 @@ 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. -With respect to =guide-key=, the intention is to provide the -following features: -1. A different polling mechanism to make it lighter on resources than guide-key -2. An improved display of keys with more keys being shown by default and a nicer - presentation -3. Customization options that allow for the rewriting of command names on the - fly through easily modifiable alists -4. Good default configurations that work well with most themes -5. A well configured back-end for displaying keys (removing the popwin - dependency) that can be easily customized by writing new display functions - -Many of these have been implemented and are described below. - ** Table of Contents :TOC@4: - [[#which-key-][which-key ]] - [[#whats-new][What's New]] @@ -335,17 +304,22 @@ available options. *** Paging Options [Note: This section is out of date given the new =C-h= commands feature described in the What's New section. I will update it soon.]. +- =C-h= commands! Now =C-h= will prompt you will several options instead of + going directly to the next page. You can (see =which-key-C-h-map=) + This is a fairly substantial change and might introduce a bug or two, so + please report anything you see that is strange and I will try to fix it. + 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-show-next-page= which will 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. +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-for-paging nil) +(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 @@ -354,23 +328,15 @@ 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. As a bonus you can type =C-x C-h= and the -which-key buffer will pop up immediately (i.e., before =which-key-idle-delay= -kicks in). - -The option =which-key-prevent-C-h-from-cycling=, which is =t= by default -allows one to take advantage of using =C-h= for paging as well as the default -Emacs behavior of using =C-h= to describe the bindings for the current key -sequence prefix. - -The default configuration below will allow you to switch paging using =C-h= -until you reach the last page of keys in the which-key buffer. The next press of -=C-h= will close the which-key buffer and trigger the default Emacs behavior on -=C-h=. -#+BEGIN_SRC emacs-lisp -(setq which-key-use-C-h-for-paging t - which-key-prevent-C-h-from-cycling t) -#+END_SRC +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. @@ -382,7 +348,7 @@ Essentially, all you need to do for a prefix like =C-x= is the following which will bind == to the relevant command. #+BEGIN_SRC emacs-lisp -(define-key which-key-mode-map (kbd "C-x ") 'which-key-show-next-page) +(define-key which-key-mode-map (kbd "C-x ") 'which-key-C-h-dispatch) #+END_SRC This is completely equivalent to @@ -455,9 +421,10 @@ shown. (setq which-key-prefix-prefix "+" ) ;; Set the special keys. These are automatically truncated to one character and - ;; have which-key-special-key-face applied. Set this variable to nil to disable - ;; the feature - (setq which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL")) + ;; 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 diff --git a/which-key.el b/which-key.el index 3aaf86c97e1..7fec216b9ee 100644 --- a/which-key.el +++ b/which-key.el @@ -1010,20 +1010,6 @@ call signature in different emacs versions" (set-frame-size (window-frame window) frame-width frame-height) window))) -;; Keep for popwin maybe (Used to work) -;; (defun which-key-show-buffer-popwin (height width) -;; "Using popwin popup buffer with dimensions HEIGHT and WIDTH." -;; (popwin:popup-buffer which-key-buffer-name -;; :height height -;; :width width -;; :noselect t -;; :position which-key-side-window-location)) - -;; (defun which-key-hide-buffer-popwin () -;; "Hide popwin buffer." -;; (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) -;; (popwin:close-popup-window))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Max dimension of available window functions @@ -1533,7 +1519,7 @@ metadata." (defun which-key--create-pages-1 (keys available-lines available-width &optional min-lines vertical) - "Create page strings using `popalist-list-to-page'. + "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 commit 23a01c9fc0d1c489a355b2bec07f4e4a791c3db9 Author: Justin Burkett Date: Thu Mar 17 13:04:33 2016 -0400 Make show-standard-help narrow to prefix This is what describe-prefix-bindings does and it should be consistent. diff --git a/which-key.el b/which-key.el index 490ca24aca0..3aaf86c97e1 100644 --- a/which-key.el +++ b/which-key.el @@ -1780,7 +1780,13 @@ Usually this is `describe-prefix-bindings'." (interactive) (let ((which-key-inhibit t)) (which-key--hide-popup-ignore-command) - (funcall which-key--prefix-help-cmd-backup))) + (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 () commit 9df87e6e36e55c55fcc7395fee7809ebd30c0396 Author: Justin Burkett Date: Mon Mar 14 07:25:54 2016 -0400 Shorten lighter name diff --git a/which-key.el b/which-key.el index ff0716beb16..490ca24aca0 100644 --- a/which-key.el +++ b/which-key.el @@ -424,8 +424,8 @@ ignored." :group 'which-key :type 'function) -(defcustom which-key-custom-lighter " WK" - "minor mode lighter to use in the mode-line." +(defcustom which-key-lighter " WK" + "Minor mode lighter to use in the mode-line." :group 'which-key :type 'string) @@ -501,7 +501,7 @@ alongside the actual current key sequence when (define-minor-mode which-key-mode "Toggle which-key-mode." :global t - :lighter which-key-custom-lighter + :lighter which-key-lighter :keymap (let ((map (make-sparse-keymap))) (mapc (lambda (prefix) commit 91ab13ee3946bb6609d47bb510f2be1e6d4b392e Author: Will S. Medrano Date: Sun Mar 13 18:07:58 2016 -0700 made minor mode lighter customizable diff --git a/which-key.el b/which-key.el index d874e18d297..ff0716beb16 100644 --- a/which-key.el +++ b/which-key.el @@ -424,6 +424,11 @@ ignored." :group 'which-key :type 'function) +(defcustom which-key-custom-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 @@ -496,7 +501,7 @@ alongside the actual current key sequence when (define-minor-mode which-key-mode "Toggle which-key-mode." :global t - :lighter " WK" + :lighter which-key-custom-lighter :keymap (let ((map (make-sparse-keymap))) (mapc (lambda (prefix) commit 2d8767caa4e926027bf106450e0df7286f5e0a2d Author: Justin Burkett Date: Thu Mar 10 19:51:58 2016 -0500 Disable special-keys option by default It's probably too surprising to have enabled by default. diff --git a/README.org b/README.org index 52429939f49..b955fbe0b9e 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,8 @@ * 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]] -** What's New +** Semi-Recent Changes +- =which-key-special-keys= is now disabled by default. See the docstring for the + old setting. - =C-h= commands! Now =C-h= will prompt you will several options instead of going directly to the next page. You can (see =which-key-C-h-map=) - Cycle through the pages forward with =n= (or =C-n=) diff --git a/which-key.el b/which-key.el index 1971dc9b84c..d874e18d297 100644 --- a/which-key.el +++ b/which-key.el @@ -150,9 +150,12 @@ the element is a cons cell, it should take the form (regexp . face to apply)." :group 'which-key) -(defcustom which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") +(defcustom which-key-special-keys '() "These keys will automatically be truncated to one character -and have `which-key-special-key-face' applied to them." +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)) commit e81b7898aca445b77808085c642d18721ba9d1f4 Author: Justin Burkett Date: Thu Mar 10 09:03:35 2016 -0500 Fix compiler warnings Fixes #106 diff --git a/which-key.el b/which-key.el index 138d46b3d40..1971dc9b84c 100644 --- a/which-key.el +++ b/which-key.el @@ -41,8 +41,12 @@ (require 'cl-lib) (require 'button) -(eval-when-compile - (defvar golden-ratio-mode)) +;; 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") (defgroup which-key nil "Customization options for which-key-mode" commit 4622d18850a5fe52af07ce18001e963fe4cfd80f Author: Justin Burkett Date: Thu Mar 3 16:43:31 2016 -0500 Increment version diff --git a/which-key.el b/which-key.el index ab0713daafd..138d46b3d40 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.8 +;; Version: 0.9 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 5e0b9b64fa6e71331f8c43c2c30587d5293be7e3 Author: Justin Burkett Date: Thu Mar 3 16:41:31 2016 -0500 Fix bug when show-prefix is left and there is one line Fixes #104 diff --git a/which-key.el b/which-key.el index 12e4d1b82c8..ab0713daafd 100644 --- a/which-key.el +++ b/which-key.el @@ -1677,7 +1677,7 @@ including prefix arguments." (make-string first-col-width 32))) lines first-line new-end) (if (= 1 height) - (concat prefix page) + (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))) commit 44c406404d21c28e470e0a6521a73d32a16d2b0a Author: Justin Burkett Date: Mon Feb 29 08:07:55 2016 -0500 Export reload-key-sequence function Fixes #103 diff --git a/which-key.el b/which-key.el index 44d893f6a4d..12e4d1b82c8 100644 --- a/which-key.el +++ b/which-key.el @@ -1739,7 +1739,12 @@ enough space based on your settings and frame size." prefix-keys) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; paging functions -(defun which-key--reload-key-sequence (key-seq) +;;;###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))) @@ -1748,7 +1753,7 @@ enough space based on your settings and frame size." prefix-keys) "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)) + (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)) @@ -1825,7 +1830,7 @@ after first page." (which-key--show-keymap (car args) (cdr args))) (which-key--hide-popup))) (key-lst - (which-key--reload-key-sequence 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) commit 69a1435dffc88af1b6e1e974945102b340798141 Merge: 0ca36cef48f 4ea4a940ffe Author: Justin Burkett Date: Sat Feb 13 09:54:50 2016 -0500 Merge pull request #102 from zonuexe/master Disable show-trailing-whitespace commit 4ea4a940ffe5d344a96923e3c467adff4c681890 Author: USAMI Kenta Date: Sat Feb 13 23:21:05 2016 +0900 Disable show-trailing-whitespace diff --git a/which-key.el b/which-key.el index 8934934c082..44d893f6a4d 100644 --- a/which-key.el +++ b/which-key.el @@ -535,6 +535,7 @@ alongside the actual current key sequence when (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 () commit 0ca36cef48fc21b0a2c2a17ef310036c1fc051f9 Author: Justin Burkett Date: Tue Feb 9 11:32:20 2016 -0500 Add missing case for which-key-show-prefix nil is a valid value for this option. diff --git a/which-key.el b/which-key.el index cf58bfc303b..8934934c082 100644 --- a/which-key.el +++ b/which-key.el @@ -1702,7 +1702,8 @@ including prefix arguments." (cons page (concat full-prefix (when prefix-keys " ") status-line (when status-line " ") - nxt-pg-hint)))))) + nxt-pg-hint))) + (_ (cons page nil))))) (defun which-key--show-page (n) "Show page N, starting from 0." commit 529e9ac9f539aadd609aba8dd96d9d7704f1423b Author: Justin Burkett Date: Sat Feb 6 20:16:07 2016 -0500 Add which-key-is-verbose Allows one to silence messages which may not indicate an error. diff --git a/which-key.el b/which-key.el index 7ddbfc98f42..cf58bfc303b 100644 --- a/which-key.el +++ b/which-key.el @@ -276,6 +276,11 @@ prefixes in `which-key-paging-prefixes'" 'which-key-use-C-h-commands "2015-12-2") +(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) @@ -650,8 +655,9 @@ bottom." (cond ((null alist) (list (cons keys value))) ((assoc-string keys alist) (when (not (string-equal (cdr (assoc-string keys alist)) value)) - (message "which-key: changing %s name from %s to %s in the %s alist" - key (cdr (assoc-string keys alist)) value alist-name) + (when which-key-is-verbose + (message "which-key: changing %s name from %s to %s in the %s alist" + key (cdr (assoc-string keys alist)) value alist-name)) (setcdr (assoc-string keys alist) value)) alist) (t (cons (cons keys value) alist))))) @@ -706,7 +712,8 @@ string." (let ((keys (key-description (kbd key-seq-str)))) (if (and (null force) (assoc-string keys which-key-prefix-title-alist)) - (message "which-key: Prefix title not added. A title exists for this prefix.") + (when which-key-is-verbose + (message "which-key: Prefix title not added. A title exists for this prefix.")) (push (cons keys title) which-key-prefix-title-alist)))) ;;;###autoload commit e7a9ebf15f30b2e8763152af4e939bfc87b9fc42 Author: Justin Burkett Date: Wed Feb 3 15:14:26 2016 -0500 Refactor create-pages and show-page diff --git a/which-key.el b/which-key.el index eae2565e3e8..7ddbfc98f42 100644 --- a/which-key.el +++ b/which-key.el @@ -1511,6 +1511,31 @@ metadata." :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 `popalist-list-to-page'. +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 @@ -1521,33 +1546,24 @@ is the width of the live window." (max-width (cdr max-dims)) (prefix-keys-desc (key-description which-key--current-prefix)) (full-prefix (which-key--full-prefix prefix-keys-desc)) - (prefix-left (when (eq which-key-show-prefix 'left) - (+ 2 (which-key--string-width full-prefix)))) + (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-left (- max-width prefix-left) max-width)) + (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)))) - (result (which-key--partition-columns keys avl-lines avl-width)) - found prev-result) - (cond ((or vertical (> (plist-get result :n-pages) 1) (= 1 avl-lines)) - result) - ;; do a simple search for the smallest number of lines - (t (while (and (> avl-lines min-lines) (not found)) - (setq avl-lines (- avl-lines 1) - prev-result result - result (which-key--partition-columns - keys avl-lines avl-width) - found (> (plist-get result :n-pages) 1))) - (if found prev-result result))))) - -(defun which-key--lighter-status (n-shown n-tot) - "Possibly show N-SHOWN keys and N-TOT keys in the mode line." + (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 - (setq which-key--lighter-backup (cadr (assq 'which-key-mode minor-mode-alist))) - (setcar (cdr (assq 'which-key-mode minor-mode-alist)) - (format " WK: %s/%s keys" n-shown n-tot)))) + (let ((n-shown (nth page-n (plist-get which-key--pages-plist :keys/page))) + (n-tot (plist-get which-key--pages-plist :tot-keys))) + (setq which-key--lighter-backup (cadr (assq 'which-key-mode minor-mode-alist))) + (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." @@ -1623,6 +1639,64 @@ including prefix arguments." (define-key map (kbd "C-h") #'which-key-C-h-dispatch)) map))) +(defun which-key--process-page (page-n pages-plist) + (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) + (concat prefix page) + (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 + (concat full-prefix (when prefix-keys " ") + status-line (when status-line " ") + nxt-pg-hint)))))) + (defun which-key--show-page (n) "Show page N, starting from 0." (which-key--init-buffer) ;; in case it was killed @@ -1635,71 +1709,17 @@ enough space based on your settings and frame size." prefix-keys) (setq page-n (mod n n-pages) which-key--current-page-n page-n) (when (= n-pages (1+ n)) (setq which-key--on-last-page t)) - (let* ((page (nth page-n (plist-get which-key--pages-plist :pages))) - (height (plist-get which-key--pages-plist :page-height)) - (width (nth page-n (plist-get which-key--pages-plist :page-widths))) - (n-shown (nth page-n (plist-get which-key--pages-plist :keys/page))) - (n-tot (plist-get which-key--pages-plist :tot-keys)) - (full-prefix (which-key--full-prefix prefix-keys)) - (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) - 'face 'which-key-separator-face)) - (status-top (propertize (which-key--maybe-get-prefix-title - (which-key--current-key-string)) - 'face 'which-key-note-face)) - (status-top (concat status-top - (when (< 1 n-pages) - (propertize (format " (%s of %s)" - (1+ page-n) n-pages) - 'face 'which-key-note-face)))) - (first-col-width (+ 2 (max (which-key--string-width full-prefix) - (which-key--string-width status-left)))) - (prefix-left (format (concat "%-" (int-to-string first-col-width) "s") - full-prefix)) - (status-left (format (concat "%-" (int-to-string first-col-width) "s") - status-left)) - (nxt-pg-hint (which-key--next-page-hint prefix-keys)) - new-end lines first) - (cond ((and (< 1 n-pages) - (eq which-key-show-prefix 'left)) - (setq lines (split-string page "\n") - first (concat prefix-left (car lines) "\n" status-left) - new-end (concat "\n" (make-string first-col-width 32)) - page (concat first (mapconcat #'identity (cdr lines) new-end)))) - ((eq which-key-show-prefix 'left) - (if (= 1 height) - (setq page (concat prefix-left page)) - (setq lines (split-string page "\n") - first (concat prefix-left (car lines) - "\n" (make-string first-col-width 32)) - new-end (concat "\n" (make-string first-col-width 32)) - page (concat first (mapconcat #'identity (cdr lines) new-end))))) - ((eq which-key-show-prefix 'top) - (setq page - (concat - (when (or (= 0 echo-keystrokes) - (not (eq which-key-side-window-location 'bottom))) - (concat full-prefix " ")) - status-top " " nxt-pg-hint "\n" page))) - ((eq which-key-show-prefix 'bottom) - (setq page - (concat - page "\n" - (when (or (= 0 echo-keystrokes) - (not (eq which-key-side-window-location 'bottom))) - (concat full-prefix " ")) - status-top " " nxt-pg-hint))) - ((eq which-key-show-prefix 'echo) - (which-key--echo (concat full-prefix - (when prefix-keys " ") - status-top (when status-top " ") - nxt-pg-hint)))) - (which-key--lighter-status n-shown n-tot) + (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 page) + (which-key--echo (car page-echo)) (with-current-buffer which-key--buffer (erase-buffer) - (insert page) + (insert (car page-echo)) (goto-char (point-min))) + (when (cdr page-echo) (which-key--echo (cdr page-echo))) (which-key--show-popup (cons height width))))) ;; used for paging at top-level (if (fboundp 'set-transient-map) commit a87e6212f84e97150b12d82bb3dc70df17e19e31 Author: Justin Burkett Date: Wed Feb 3 15:13:24 2016 -0500 Improve some function names diff --git a/which-key.el b/which-key.el index e115c21d8ed..eae2565e3e8 100644 --- a/which-key.el +++ b/which-key.el @@ -1429,7 +1429,7 @@ BUFFER that follow the key sequence KEY-SEQ." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for laying out which-key buffer pages -(defun which-key--pad (columns) +(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))) @@ -1442,7 +1442,7 @@ BUFFER that follow the key sequence KEY-SEQ." (defsubst which-key--join-columns (columns) "Transpose columns into rows, concat rows into lines and rows into page." - (let* ((padded (which-key--pad (nreverse columns))) + (let* ((padded (which-key--normalize-columns (nreverse columns))) (rows (apply #'cl-mapcar #'list padded))) (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n"))) @@ -1477,9 +1477,10 @@ that width." list (nthcdr n list))) (nreverse res))) -(defun which-key--partition-columns (keys avl-lines avl-width) +(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." +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) @@ -1511,7 +1512,7 @@ Returns a plist that holds the page strings, as well as metadata." :tot-keys (apply #'+ keys/page))))) (defun which-key--create-pages (keys) - "Create page strings using `which-key--partition-columns'. + "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." commit d24c12f563021047ce237bc7fe3276775b3882a6 Author: Justin Burkett Date: Wed Feb 3 12:40:35 2016 -0500 Don't pass window-width around diff --git a/which-key.el b/which-key.el index f6ad1ff3984..e115c21d8ed 100644 --- a/which-key.el +++ b/which-key.el @@ -1007,7 +1007,7 @@ call signature in different emacs versions" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Max dimension of available window functions -(defun which-key--popup-max-dimensions (selected-window-width) +(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 @@ -1016,7 +1016,8 @@ window." (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 selected-window-width)))) + (custom (funcall which-key-custom-popup-max-dimensions-function + (window-width))))) (defun which-key--minibuffer-max-dimensions () "Return max-dimensions of minibuffer (height . width). @@ -1509,12 +1510,12 @@ Returns a plist that holds the page strings, as well as metadata." :keys/page (reverse keys/page) :n-pages n-pages :tot-keys (apply #'+ keys/page))))) -(defun which-key--create-pages (keys sel-win-width) +(defun which-key--create-pages (keys) "Create page strings using `which-key--partition-columns'. 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 sel-win-width)) + (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)) @@ -1843,7 +1844,7 @@ prefix) if `which-key-use-C-h-commands' is non nil." (let (pages1) (let ((which-key-side-window-location loc1) (which-key--multiple-locations t)) - (setq pages1 (which-key--create-pages keys (window-width)))) + (setq pages1 (which-key--create-pages keys))) (if (< 0 (plist-get pages1 :n-pages)) (progn (setq which-key--pages-plist pages1) @@ -1853,8 +1854,8 @@ prefix) if `which-key-use-C-h-commands' is non nil." loc1) (let ((which-key-side-window-location loc2) (which-key--multiple-locations t)) - (setq which-key--pages-plist (which-key--create-pages - keys (window-width))) + (setq which-key--pages-plist + (which-key--create-pages keys)) (which-key--show-page page-n) loc2)))) @@ -1905,7 +1906,7 @@ is selected interactively by mode in `minor-mode-map-alist'." (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 (window-width))) + (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)))) @@ -1942,7 +1943,7 @@ is selected interactively by mode in `minor-mode-map-alist'." (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 (window-width))) + (which-key--create-pages formatted-keys)) (which-key--show-page 0))))) (let* ((key (key-description (list (read-key))))) (when (string= key "`") @@ -1971,7 +1972,7 @@ Finally, show the buffer." (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 (window-width))) + (which-key--create-pages formatted-keys)) (which-key--show-page 0))))) (defun which-key--update () commit e1f2e6be99633906865ec3aba0454a0d50d6dba3 Author: Justin Burkett Date: Wed Feb 3 08:27:40 2016 -0500 Fix problems with operator keymap function 1. Introduce using-show-keymap and using-show-operator-keymap vars to make it clear how we are entering which-key 2. Add inhibit-next-operator-keymap for keys in the operator maps that are bound to commands that read the next key "manually" 3. Fix problem where the next page hint was only being shown sometimes in the operator maps. Need to distinguish between show-operator-keymap and the possibility that an operator is active but the usual which-key popup is showing. diff --git a/which-key.el b/which-key.el index e74c9ed7742..f6ad1ff3984 100644 --- a/which-key.el +++ b/which-key.el @@ -453,6 +453,9 @@ showing.") 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) @@ -843,6 +846,8 @@ total height." (unless (member real-this-command which-key--paging-functions) (setq which-key--current-page-n 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) @@ -1566,8 +1571,9 @@ area." (key-binding (kbd paging-key)))) (key (if paging-key-bound which-key-paging-key "C-h"))) (when (and which-key-use-C-h-commands - (not (and which-key-allow-evil-operators - (bound-and-true-p evil-this-operator)))) + (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)))) @@ -1886,7 +1892,8 @@ is selected interactively by mode in `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--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 @@ -1915,35 +1922,40 @@ is selected interactively by mode in `minor-mode-map-alist'." (evil-get-command-property def :suppress-operator))) (defun which-key--show-evil-operator-keymap () - (let ((keymap-name "evil operator state keys + motion keys") - (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 keymap-name) - (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 (window-width))) - (which-key--show-page 0))))) - (let* ((key (key-description (list (read-key))))) - (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))))))) + (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 (window-width))) + (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) "Fill `which-key--buffer' with key descriptions and reformat. @@ -1988,11 +2000,13 @@ Finally, show the buffer." (which-key--start-timer which-key-idle-secondary-delay))) ((and which-key-show-operator-state-maps (bound-and-true-p evil-state) - (eq evil-state 'operator)) + (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--current-show-keymap-name)) + (not which-key--using-show-operator-keymap) + (not which-key--using-show-keymap)) (which-key--hide-popup))))) ;; Timers commit dce72aa134b706c1846502dd58a1141f4e2b0f6b Author: Justin Burkett Date: Wed Feb 3 08:24:54 2016 -0500 Simplify page turning function diff --git a/which-key.el b/which-key.el index 9a40bb21beb..e74c9ed7742 100644 --- a/which-key.el +++ b/which-key.el @@ -1703,35 +1703,21 @@ enough space based on your settings and frame size." prefix-keys) ;; paging functions (defun which-key--reload-key-sequence (key-seq) - (let ((next-event (mapcar (lambda (ev) (cons t ev)) - (if (listp key-seq) - key-seq - (listify-key-sequence key-seq))))) + (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. -Will force an update if called before `which-key--update'." - (cond - ;; No which-key buffer showing - ((null which-key--current-page-n) - (let* ((keysbl - (vconcat (butlast (append (this-single-command-keys) nil))))) - (which-key--reload-key-sequence keysbl) - (which-key--create-buffer-and-show keysbl))) - ;; which-key buffer showing. turn page - (t - (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))))) + "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 () commit f6f4aee3404272d871b0c2111a7a41d680a1c071 Author: Justin Burkett Date: Wed Feb 3 08:23:55 2016 -0500 Use keyboard-quit in abort key sequence Need to do this for the operator keymap function. Otherwise the operator state doesn't exit properly diff --git a/which-key.el b/which-key.el index ab564626140..9a40bb21beb 100644 --- a/which-key.el +++ b/which-key.el @@ -1812,7 +1812,7 @@ after first page." (interactive) (let ((which-key-inhibit t)) (which-key--hide-popup-ignore-command) - (message "Aborted key sequence"))) + (keyboard-quit))) ;;;###autoload (defun which-key-C-h-dispatch () commit 6ddebba30c4073c917934d62d142cd2ff7b40e76 Author: Justin Burkett Date: Wed Feb 3 08:22:53 2016 -0500 Comment out window var and add new func The window var is not being used. diff --git a/which-key.el b/which-key.el index 738275dc421..ab564626140 100644 --- a/which-key.el +++ b/which-key.el @@ -422,8 +422,8 @@ to a non-nil value for the execution of a command. Like this ;; Internal Vars (defvar which-key--buffer nil "Internal: Holds reference to which-key buffer.") -(defvar which-key--window nil - "Internal: Holds reference to which-key window.") +;; (defvar which-key--window nil +;; "Internal: Holds reference to which-key window.") (defvar which-key--timer nil "Internal: Holds reference to open window timer.") (defvar which-key--paging-timer nil @@ -875,6 +875,9 @@ total height." (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 commit 094136858f8d6461d80fc94319638b16bc194373 Author: Justin Burkett Date: Fri Jan 29 21:08:12 2016 -0500 Don't listify key sequence repeatedly This function is not idempotent it turns out. diff --git a/which-key.el b/which-key.el index 37370764f4a..738275dc421 100644 --- a/which-key.el +++ b/which-key.el @@ -1701,7 +1701,9 @@ enough space based on your settings and frame size." prefix-keys) (defun which-key--reload-key-sequence (key-seq) (let ((next-event (mapcar (lambda (ev) (cons t ev)) - (listify-key-sequence key-seq)))) + (if (listp key-seq) + key-seq + (listify-key-sequence key-seq))))) (setq prefix-arg current-prefix-arg unread-command-events next-event))) commit 9c93581566ac66f00af870aeb11aef53dee4d39c Author: Justin Burkett Date: Fri Jan 29 20:41:15 2016 -0500 Interpret ESC in operator popup See #99 diff --git a/which-key.el b/which-key.el index 3b8927d05c2..37370764f4a 100644 --- a/which-key.el +++ b/which-key.el @@ -1947,8 +1947,12 @@ is selected interactively by mode in `minor-mode-map-alist'." (let* ((key (key-description (list (read-key))))) (cond ((and which-key-use-C-h-commands (string= "C-h" key)) (which-key-C-h-dispatch)) - (t (setq unread-command-events (listify-key-sequence key)) - (which-key--hide-popup)))))) + ((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) "Fill `which-key--buffer' with key descriptions and reformat. commit d9bb55cd0001b2dff34e766bee26db32dbe6e631 Author: Justin Burkett Date: Thu Jan 28 15:39:47 2016 -0500 Improve previous commit Filter out keys with :suppress-keymap property, which seem to be the primary ones ignored in operator state diff --git a/which-key.el b/which-key.el index 09ab770bdc1..3b8927d05c2 100644 --- a/which-key.el +++ b/which-key.el @@ -1336,18 +1336,19 @@ alists. Returns a list (key separator description)." (list key-w-face sep-w-face desc-w-face))) unformatted))) -(defun which-key--get-keymap-bindings (keymap) +(defun which-key--get-keymap-bindings (keymap &optional filter) "Retrieve top-level bindings from KEYMAP." (let (bindings) (map-keymap (lambda (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))))) + (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)) @@ -1918,26 +1919,36 @@ is selected interactively by mode in `minor-mode-map-alist'." (cons keymap-name keymap))) (t (which-key--hide-popup))))) -(defun which-key--show-keymap-no-intercept (keymap-name keymap) - (setq which-key--current-prefix nil - which-key--current-show-keymap-name keymap-name) - (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 (window-width))) - (which-key--show-page 0))))) - (let* ((key (key-description (list (read-key))))) - (cond ((and which-key-use-C-h-commands (string= "C-h" key)) - (which-key-C-h-dispatch)) - (t (setq unread-command-events (listify-key-sequence key)) - (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 () + (let ((keymap-name "evil operator state keys + motion keys") + (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 keymap-name) + (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 (window-width))) + (which-key--show-page 0))))) + (let* ((key (key-description (list (read-key))))) + (cond ((and which-key-use-C-h-commands (string= "C-h" key)) + (which-key-C-h-dispatch)) + (t (setq unread-command-events (listify-key-sequence key)) + (which-key--hide-popup)))))) (defun which-key--create-buffer-and-show (&optional prefix-keys) "Fill `which-key--buffer' with key descriptions and reformat. @@ -1983,11 +1994,7 @@ Finally, show the buffer." ((and which-key-show-operator-state-maps (bound-and-true-p evil-state) (eq evil-state 'operator)) - (which-key--show-keymap-no-intercept - "evil operator state keys + motion keys" - (make-composed-keymap (list evil-operator-shortcut-map - evil-operator-state-map - evil-motion-state-map)))) + (which-key--show-evil-operator-keymap)) ((and which-key--current-page-n (not which-key--using-top-level) (not which-key--current-show-keymap-name)) commit 456053cd703b0e4ca1f4852930bf9ef6a83bb376 Merge: f3681e93c57 f69f694d8aa Author: Justin Burkett Date: Thu Jan 28 15:04:05 2016 -0500 Merge branch 'master' of https://github.com/justbur/emacs-which-key commit f3681e93c57a62daba92e3a2ff39ad3331924b3f Author: Justin Burkett Date: Thu Jan 28 15:03:27 2016 -0500 Initial try at addressing #99 diff --git a/which-key.el b/which-key.el index dcd1deb00da..09ab770bdc1 100644 --- a/which-key.el +++ b/which-key.el @@ -321,6 +321,14 @@ prefixes in `which-key-paging-prefixes'" :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) + (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 @@ -1203,7 +1211,8 @@ An empty stiring is returned if no title exists." (t "")))) (which-key--using-top-level "Top-level bindings") (which-key--current-show-keymap-name - which-key--current-show-keymap-name))) + which-key--current-show-keymap-name) + (t ""))) (defun which-key--maybe-replace-key-based (string keys) "KEYS is a string produced by `key-description' @@ -1909,6 +1918,27 @@ is selected interactively by mode in `minor-mode-map-alist'." (cons keymap-name keymap))) (t (which-key--hide-popup))))) +(defun which-key--show-keymap-no-intercept (keymap-name keymap) + (setq which-key--current-prefix nil + which-key--current-show-keymap-name keymap-name) + (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 (window-width))) + (which-key--show-page 0))))) + (let* ((key (key-description (list (read-key))))) + (cond ((and which-key-use-C-h-commands (string= "C-h" key)) + (which-key-C-h-dispatch)) + (t (setq unread-command-events (listify-key-sequence key)) + (which-key--hide-popup))))) + (defun which-key--create-buffer-and-show (&optional prefix-keys) "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." @@ -1950,6 +1980,14 @@ Finally, show the buffer." (which-key--create-buffer-and-show prefix-keys) (when which-key-idle-secondary-delay (which-key--start-timer which-key-idle-secondary-delay))) + ((and which-key-show-operator-state-maps + (bound-and-true-p evil-state) + (eq evil-state 'operator)) + (which-key--show-keymap-no-intercept + "evil operator state keys + motion keys" + (make-composed-keymap (list evil-operator-shortcut-map + evil-operator-state-map + evil-motion-state-map)))) ((and which-key--current-page-n (not which-key--using-top-level) (not which-key--current-show-keymap-name)) commit f69f694d8aa582b4fb1c1aa7506a051f2e5aa6bc Merge: f1d3d1b5e53 5909fb2fc3c Author: Justin Burkett Date: Tue Jan 26 07:55:58 2016 -0500 Merge pull request #100 from yatesco/patch-1 Trivial fix correcting SpacEmacs commit 5909fb2fc3cfa924cfecf597de0003c4cdfaccc6 Author: Colin Yates Date: Tue Jan 26 12:47:58 2016 +0000 Trivial fix correcting SpacEmacs diff --git a/README.org b/README.org index 65cc49f6bf1..52429939f49 100644 --- a/README.org +++ b/README.org @@ -109,7 +109,7 @@ screenshots. There are other substitution abilities included, which are quite flexible (ability to use regexp for example). This makes which-key very customizable. -This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacEmacs]]. +This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacemacs]]. *** Side Window Bottom Option Popup side window on bottom. This is the current default. To restore this setup use commit f1d3d1b5e5351e5f878643496d8523fd54a96ca3 Author: Justin Burkett Date: Sun Jan 17 20:55:04 2016 -0500 Add which-key-idle-secondary-delay Allows the delay time to be different for popups that follow an initial popup within the same key sequence. diff --git a/which-key.el b/which-key.el index c5ce0ff506a..dcd1deb00da 100644 --- a/which-key.el +++ b/which-key.el @@ -54,6 +54,15 @@ :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 0 "Value to use for `echo-keystrokes'. This only applies if `which-key-popup-type' is minibuffer or @@ -829,6 +838,8 @@ total height." which-key--current-show-keymap-name nil which-key--prior-show-keymap-args nil which-key--on-last-page nil) + (when which-key-idle-secondary-delay + (which-key--start-timer)) (cl-case which-key-popup-type ;; Not necessary to hide minibuffer ;; (minibuffer (which-key--hide-buffer-minibuffer)) @@ -1933,9 +1944,12 @@ Finally, show the buffer." (not which-key-inhibit) ;; 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)) + (or (and which-key-allow-evil-operators + (bound-and-true-p evil-this-operator)) (null this-command))) - (which-key--create-buffer-and-show prefix-keys)) + (which-key--create-buffer-and-show prefix-keys) + (when which-key-idle-secondary-delay + (which-key--start-timer which-key-idle-secondary-delay))) ((and which-key--current-page-n (not which-key--using-top-level) (not which-key--current-show-keymap-name)) @@ -1943,11 +1957,14 @@ Finally, show the buffer." ;; Timers -(defun which-key--start-timer () +(defun which-key--start-timer (&optional delay) "Activate idle timer to trigger `which-key--update'." (which-key--stop-timer) (setq which-key--timer - (run-with-idle-timer which-key-idle-delay t #'which-key--update))) + (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'." commit 9bb70c8cdd43f0cd76871fddc4dd3ee1bccd3897 Author: Justin Burkett Date: Mon Jan 11 09:56:49 2016 -0500 Fix problem with side-window dimension calculation The fringes were not being included in version 24. This makes the calculation consistent with the left/right side-window calculation and fixes #97. diff --git a/which-key.el b/which-key.el index a952a9831dc..c5ce0ff506a 100644 --- a/which-key.el +++ b/which-key.el @@ -1019,7 +1019,8 @@ width) in lines and characters respectively." (- (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)) - (frame-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 () commit f4a1b4283bf09475e5255a889a34784501ad2fc0 Author: Justin Burkett Date: Mon Dec 21 12:12:29 2015 -0500 Fix C-h prompt for show-keymap commands diff --git a/which-key.el b/which-key.el index f21fd23fcd6..a952a9831dc 100644 --- a/which-key.el +++ b/which-key.el @@ -1796,7 +1796,10 @@ prefix) if `which-key-use-C-h-commands' is non nil." (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 " Top-level bindings" 'face 'which-key-note-face)) + (propertize (concat " " + (or which-key--current-show-keymap-name + "Top-level bindings")) + 'face 'which-key-note-face)) full-prefix (propertize (substitute-command-keys commit 92dc5871f01d2297349ecbf075d2263a846f1146 Author: Justin Burkett Date: Sun Dec 20 19:36:05 2015 -0500 Fix undo for show-keymap diff --git a/which-key.el b/which-key.el index 3f383cd8e9f..f21fd23fcd6 100644 --- a/which-key.el +++ b/which-key.el @@ -436,7 +436,8 @@ showing.") used.") (defvar which-key--multiple-locations nil) (defvar which-key--using-top-level nil) -(defvar which-key--using-show-keymap nil) +(defvar which-key--current-show-keymap-name nil) +(defvar which-key--prior-show-keymap-args nil) (defvar which-key-key-based-description-replacement-alist '() "New version of @@ -825,7 +826,8 @@ total height." (unless (member real-this-command which-key--paging-functions) (setq which-key--current-page-n nil which-key--using-top-level nil - which-key--using-show-keymap nil + which-key--current-show-keymap-name nil + which-key--prior-show-keymap-args nil which-key--on-last-page nil) (cl-case which-key-popup-type ;; Not necessary to hide minibuffer @@ -1123,6 +1125,9 @@ coming before a prefix. Within these categories order using "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--maybe-replace (string repl-alist &optional literal) "Perform replacements on STRING. REPL-ALIST is an alist where the car of each element is the text @@ -1164,26 +1169,29 @@ a replacement occurs return the new STRING." "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." - (if (not (string-equal keys "")) - (let* ((alist which-key-prefix-title-alist) - (res (assoc-string keys alist)) - (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist - (assoc-string keys mode-alist))) - (binding (key-binding keys)) - (alternate (when (and binding (symbolp binding)) - (symbol-name binding)))) - (cond (mode-res (cdr mode-res)) - (res (cdr 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 ""))) - "Top-level bindings")) + (cond + ((not (string-equal keys "")) + (let* ((alist which-key-prefix-title-alist) + (res (assoc-string keys alist)) + (mode-alist (assq major-mode alist)) + (mode-res (when mode-alist + (assoc-string keys mode-alist))) + (binding (key-binding keys)) + (alternate (when (and binding (symbolp binding)) + (symbol-name binding)))) + (cond (mode-res (cdr mode-res)) + (res (cdr 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))) (defun which-key--maybe-replace-key-based (string keys) "KEYS is a string produced by `key-description' @@ -1761,12 +1769,15 @@ after first page." (interactive) (let* ((key-lst (butlast (which-key--current-key-list))) (which-key-inhibit t)) - (if key-lst - (progn - (which-key--reload-key-sequence key-lst) - (which-key--create-buffer-and-show - (apply #'vector key-lst))) - (which-key-show-top-level)))) + (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 () @@ -1829,42 +1840,43 @@ prefix) if `which-key-use-C-h-commands' is non nil." "Show the top-level bindings in KEYMAP using which-key. KEYMAP is selected interactively from all available keymaps." (interactive) - (which-key--show-keymap - (symbol-value - (intern - (completing-read - "Keymap: " obarray - (lambda (m) - (and (boundp m) - (keymapp (symbol-value m)) - (not (equal (symbol-value m) (make-sparse-keymap))))) - t nil 'variable-name-history))))) + (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 'variable-name-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 (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 'variable-name-history)))) - (which-key--show-keymap (cdr (assq mode minor-mode-map-alist))))) - -(defun which-key--show-keymap (keymap) + (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 'variable-name-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--using-show-keymap t) + which-key--current-show-keymap-name keymap-name) + (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))) - (prefix-keys (key-description which-key--current-prefix))) + (which-key--get-keymap-bindings keymap)))) (cond ((= (length formatted-keys) 0) - (message "%s- which-key: There are no keys to show" prefix-keys)) + (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 @@ -1872,12 +1884,15 @@ is selected interactively by mode in `minor-mode-map-alist'." (t (setq which-key--pages-plist (which-key--create-pages formatted-keys (window-width))) (which-key--show-page 0))))) - (let* ((key (string (read-key))) - (next-def (lookup-key keymap key))) - (if (keymapp next-def) - (progn (which-key--hide-popup-ignore-command) - (which-key--show-keymap next-def)) - (which-key--hide-popup)))) + (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--create-buffer-and-show (&optional prefix-keys) "Fill `which-key--buffer' with key descriptions and reformat. @@ -1919,7 +1934,7 @@ Finally, show the buffer." (which-key--create-buffer-and-show prefix-keys)) ((and which-key--current-page-n (not which-key--using-top-level) - (not which-key--using-show-keymap)) + (not which-key--current-show-keymap-name)) (which-key--hide-popup))))) ;; Timers commit c1e82229ad1e0e6377272b553e71ecabd1f9aec6 Author: Justin Burkett Date: Sun Dec 20 17:18:22 2015 -0500 Distinguish using-show-keymap diff --git a/which-key.el b/which-key.el index 0fdf6fe6255..3f383cd8e9f 100644 --- a/which-key.el +++ b/which-key.el @@ -436,6 +436,7 @@ showing.") used.") (defvar which-key--multiple-locations nil) (defvar which-key--using-top-level nil) +(defvar which-key--using-show-keymap nil) (defvar which-key-key-based-description-replacement-alist '() "New version of @@ -824,6 +825,7 @@ total height." (unless (member real-this-command which-key--paging-functions) (setq which-key--current-page-n nil which-key--using-top-level nil + which-key--using-show-keymap nil which-key--on-last-page nil) (cl-case which-key-popup-type ;; Not necessary to hide minibuffer @@ -1856,7 +1858,7 @@ is selected interactively by mode in `minor-mode-map-alist'." (defun which-key--show-keymap (keymap) (setq which-key--current-prefix nil - which-key--using-top-level t) + which-key--using-show-keymap t) (when (keymapp keymap) (let ((formatted-keys (which-key--get-formatted-key-bindings (which-key--get-keymap-bindings keymap))) @@ -1915,7 +1917,9 @@ Finally, show the buffer." (or (and which-key-allow-evil-operators (bound-and-true-p evil-this-operator)) (null this-command))) (which-key--create-buffer-and-show prefix-keys)) - ((and which-key--current-page-n (not which-key--using-top-level)) + ((and which-key--current-page-n + (not which-key--using-top-level) + (not which-key--using-show-keymap)) (which-key--hide-popup))))) ;; Timers commit 38811018fb3531aeb3ea4288704ac1519ac6de91 Author: Justin Burkett Date: Sun Dec 20 15:54:53 2015 -0500 Allow traversal of keymaps in new commands diff --git a/which-key.el b/which-key.el index e5ca81dcc1f..0fdf6fe6255 100644 --- a/which-key.el +++ b/which-key.el @@ -1869,7 +1869,13 @@ is selected interactively by mode in `minor-mode-map-alist'." formatted-keys 0 which-key-side-window-location))) (t (setq which-key--pages-plist (which-key--create-pages formatted-keys (window-width))) - (which-key--show-page 0)))))) + (which-key--show-page 0))))) + (let* ((key (string (read-key))) + (next-def (lookup-key keymap key))) + (if (keymapp next-def) + (progn (which-key--hide-popup-ignore-command) + (which-key--show-keymap next-def)) + (which-key--hide-popup)))) (defun which-key--create-buffer-and-show (&optional prefix-keys) "Fill `which-key--buffer' with key descriptions and reformat. commit aa06530d064d8b4354f93029e101fe380e65a84b Author: Justin Burkett Date: Sun Dec 20 15:38:38 2015 -0500 Filter out empty keymaps in new functions diff --git a/which-key.el b/which-key.el index 329e0a19089..e5ca81dcc1f 100644 --- a/which-key.el +++ b/which-key.el @@ -1827,30 +1827,32 @@ prefix) if `which-key-use-C-h-commands' is non nil." "Show the top-level bindings in KEYMAP using which-key. KEYMAP is selected interactively from all available keymaps." (interactive) - (let ((map - (symbol-value - (intern - (completing-read "Keymap: " obarray - (lambda (m) (and (boundp m) (keymapp (symbol-value m)))) - t nil 'variable-name-history))))) - (if (equal map (make-sparse-keymap)) - (message "which-key: %s is empty" map) - (which-key--show-keymap map)))) + (which-key--show-keymap + (symbol-value + (intern + (completing-read + "Keymap: " obarray + (lambda (m) + (and (boundp m) + (keymapp (symbol-value m)) + (not (equal (symbol-value m) (make-sparse-keymap))))) + t nil 'variable-name-history))))) (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 (intern - (completing-read - "Minor Mode: " - (cl-remove-if-not (lambda (mode) (symbol-value mode)) - (mapcar 'car minor-mode-map-alist)) - nil t nil 'variable-name-history))) - (map (cdr (assq mode minor-mode-map-alist)))) - (if (equal map (make-sparse-keymap)) - (message "which-key: %s's keymap is empty" mode) - (which-key--show-keymap map)))) + (let ((mode (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 'variable-name-history)))) + (which-key--show-keymap (cdr (assq mode minor-mode-map-alist))))) (defun which-key--show-keymap (keymap) (setq which-key--current-prefix nil commit 6702c2ed98e5ce60571849ab53521c0246dae133 Author: Justin Burkett Date: Sun Dec 20 15:31:57 2015 -0500 Add which-key-show-minor-mode-keymap Version of which-key-show-keymap that only looks in minor-mode-map-alist diff --git a/which-key.el b/which-key.el index 4a9d11c222a..329e0a19089 100644 --- a/which-key.el +++ b/which-key.el @@ -1823,17 +1823,41 @@ prefix) if `which-key-use-C-h-commands' is non nil." (which-key--show-page page-n) loc2)))) -(defun which-key-show-keymap (keymap) - "Show the top-level bindings in KEYMAP using which-key." - (interactive (list (intern - (completing-read "Keymap: " obarray - (lambda (m) (and (boundp m) (keymapp (symbol-value m)))) - t nil 'variable-name-history)))) +(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 ((map + (symbol-value + (intern + (completing-read "Keymap: " obarray + (lambda (m) (and (boundp m) (keymapp (symbol-value m)))) + t nil 'variable-name-history))))) + (if (equal map (make-sparse-keymap)) + (message "which-key: %s is empty" map) + (which-key--show-keymap map)))) + +(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 (intern + (completing-read + "Minor Mode: " + (cl-remove-if-not (lambda (mode) (symbol-value mode)) + (mapcar 'car minor-mode-map-alist)) + nil t nil 'variable-name-history))) + (map (cdr (assq mode minor-mode-map-alist)))) + (if (equal map (make-sparse-keymap)) + (message "which-key: %s's keymap is empty" mode) + (which-key--show-keymap map)))) + +(defun which-key--show-keymap (keymap) (setq which-key--current-prefix nil which-key--using-top-level t) - (when (and (boundp keymap) (keymapp (symbol-value keymap))) + (when (keymapp keymap) (let ((formatted-keys (which-key--get-formatted-key-bindings - (which-key--get-keymap-bindings (symbol-value keymap)))) + (which-key--get-keymap-bindings 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)) commit 4a10ab21287a35c570ad95450fdca96fdcd65a69 Author: Justin Burkett Date: Sun Dec 20 13:19:16 2015 -0500 Add which-key-show-keymap Basic version of this command that only shows the top-level of a keymap. Waiting for feedback on how this should work. diff --git a/which-key.el b/which-key.el index b04af5cd446..4a9d11c222a 100644 --- a/which-key.el +++ b/which-key.el @@ -1305,6 +1305,21 @@ alists. Returns a list (key separator description)." (list key-w-face sep-w-face desc-w-face))) unformatted))) +(defun which-key--get-keymap-bindings (keymap) + "Retrieve top-level bindings from KEYMAP." + (let (bindings) + (map-keymap + (lambda (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)) + ;; adapted from helm-descbinds (defun which-key--get-current-bindings () (let ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) @@ -1361,10 +1376,10 @@ alists. Returns a list (key separator description)." (forward-line)) (nreverse bindings))))) -(defun which-key--get-formatted-key-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 (which-key--get-current-bindings))) + (let* ((unformatted (if bindings bindings (which-key--get-current-bindings)))) (when which-key-sort-order (setq unformatted (sort unformatted (lambda (a b) (funcall which-key-sort-order a b))))) @@ -1808,6 +1823,28 @@ prefix) if `which-key-use-C-h-commands' is non nil." (which-key--show-page page-n) loc2)))) +(defun which-key-show-keymap (keymap) + "Show the top-level bindings in KEYMAP using which-key." + (interactive (list (intern + (completing-read "Keymap: " obarray + (lambda (m) (and (boundp m) (keymapp (symbol-value m)))) + t nil 'variable-name-history)))) + (setq which-key--current-prefix nil + which-key--using-top-level t) + (when (and (boundp keymap) (keymapp (symbol-value keymap))) + (let ((formatted-keys (which-key--get-formatted-key-bindings + (which-key--get-keymap-bindings (symbol-value 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 (window-width))) + (which-key--show-page 0)))))) + (defun which-key--create-buffer-and-show (&optional prefix-keys) "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." commit ad60a6c7206752d9b9cf4ba17c2293dba365e9fb Author: Justin Burkett Date: Thu Dec 17 09:27:22 2015 -0500 New stable version diff --git a/which-key.el b/which-key.el index 09cc404b7a3..b04af5cd446 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.7.1 +;; Version: 0.8 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 14a11c6d69fea066a56cec0ce2702580ef86a9f1 Author: Justin Burkett Date: Fri Dec 11 15:29:59 2015 -0500 Ignore evil-state bindings These are the fake keys that evil uses to store maps under diff --git a/which-key.el b/which-key.el index 5986ae6af7c..09cc404b7a3 100644 --- a/which-key.el +++ b/which-key.el @@ -1310,7 +1310,7 @@ alists. Returns a list (key separator description)." (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 "mouse-\\|wheel-\\|remap\\|drag-\\|scroll-bar\\|select-window\\|switch-frame") + (ignore-keys-regexp "mouse-\\|wheel-\\|remap\\|drag-\\|scroll-bar\\|select-window\\|switch-frame\\|-state") (ignore-sections-regexp "\\(Key translations\\|Function key map translations\\|Input decoding map translations\\)")) (with-temp-buffer (let ((indent-tabs-mode t)) commit 2932f8a35334e7ace54244a6febe5e589239969c Merge: 47ef300b855 8ff27a120fb Author: Justin Burkett Date: Thu Dec 10 20:03:48 2015 -0500 Merge branch 'master' of https://github.com/justbur/emacs-which-key commit 47ef300b855a8aaab89c665f7014963523a7d15c Author: Justin Burkett Date: Thu Dec 10 20:02:58 2015 -0500 Add which-key-init-buffer-hook diff --git a/which-key.el b/which-key.el index 8254b60eb15..5986ae6af7c 100644 --- a/which-key.el +++ b/which-key.el @@ -321,6 +321,10 @@ See http://www.gnu.org/software/emacs/manual/html_node/emacs/Modifier-Keys.html" :group 'which-key :type 'boolean) +;; Hooks +(defvar which-key-init-buffer-hook '() + "Hook run when which-key buffer is initialized.") + ;; Faces (defgroup which-key-faces nil "Faces for which-key-mode" @@ -503,7 +507,8 @@ alongside the actual current key sequence when (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 word-wrap nil) + (run-hooks 'which-key-init-buffer-hook)))) (defun which-key--setup () "Initial setup for which-key. commit 8ff27a120fbfa8019512f597f9583b9b44abfb44 Merge: 30bc0c224ba 06c312b4d57 Author: Justin Burkett Date: Wed Dec 9 16:23:48 2015 -0500 Merge pull request #91 from Amorymeltzer/prefix-prefix-doc Document which-key-prefix-prefix commit 06c312b4d578f342b6d02d62831079bc1587e984 Author: Amory Meltzer Date: Wed Dec 9 13:19:23 2015 -0800 Document which-key-prefix-prefix https://github.com/justbur/emacs-which-key/commit/30bc0c224bac091fcf2759c8e8853e7237196090 diff --git a/README.org b/README.org index e6a94880ef2..65cc49f6bf1 100644 --- a/README.org +++ b/README.org @@ -448,6 +448,10 @@ shown. (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. Set this variable to nil to disable ;; the feature commit 30bc0c224bac091fcf2759c8e8853e7237196090 Author: Justin Burkett Date: Tue Dec 8 20:24:23 2015 -0500 Allow custom prefix-prefix Suggested in #90. Thanks @Amorymeltzer diff --git a/which-key.el b/which-key.el index 059cceda9ae..8254b60eb15 100644 --- a/which-key.el +++ b/which-key.el @@ -98,7 +98,15 @@ of the which-key popup." (defcustom which-key-separator (if which-key-dont-use-unicode " : " " → ") - "Separator to use between key and description." + "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) @@ -1240,7 +1248,7 @@ ORIGINAL-DESCRIPTION is the description given by (let* ((desc description) (desc (if (string-match-p "^group:" desc) (substring desc 6) desc)) - (desc (if group (concat "+" desc) 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) commit 37f28136dd66d057faa9b5c3a1ce05585f118304 Author: Justin Burkett Date: Sun Dec 6 13:29:25 2015 -0500 Tweak display of key sequence in one case This is for the C-h commands when the which-key message is not shown in the echo area but the echo-keystrokes prefix is diff --git a/which-key.el b/which-key.el index 3c9c117eaf5..059cceda9ae 100644 --- a/which-key.el +++ b/which-key.el @@ -1527,7 +1527,7 @@ area." (if (= n 4) str (format " %s" prefix-arg)))) (_ (format " %s" prefix-arg)))))))) -(defun which-key--full-prefix (prefix-keys &optional -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)) @@ -1538,7 +1538,7 @@ including prefix arguments." prefix-keys)) (dash (if (and which-key--current-prefix (null left)) "-" ""))) - (if (eq which-key-show-prefix 'echo) + (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))))) @@ -1753,7 +1753,7 @@ after first page." prefix) if `which-key-use-C-h-commands' is non nil." (interactive) (let* ((prefix-keys (key-description which-key--current-prefix)) - (full-prefix (which-key--full-prefix prefix-keys current-prefix-arg)) + (full-prefix (which-key--full-prefix prefix-keys current-prefix-arg t)) (prompt (concat (when (string-equal prefix-keys "") (propertize " Top-level bindings" 'face 'which-key-note-face)) full-prefix commit dd77323e9eed94d55bf998bf1f6ccac4797ab59b Author: Justin Burkett Date: Sun Dec 6 13:16:05 2015 -0500 echo-keystrokes should never be nil The correct test is to test if it's 0. diff --git a/which-key.el b/which-key.el index a7e86c963af..3c9c117eaf5 100644 --- a/which-key.el +++ b/which-key.el @@ -1527,10 +1527,11 @@ area." (if (= n 4) str (format " %s" prefix-arg)))) (_ (format " %s" prefix-arg)))))))) -(defun which-key--full-prefix (prefix-keys) +(defun which-key--full-prefix (prefix-keys &optional -prefix-arg) "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 " ") @@ -1604,17 +1605,17 @@ enough space based on your settings and frame size." prefix-keys) ((eq which-key-show-prefix 'top) (setq page (concat - (when (or (null echo-keystrokes) + (when (or (= 0 echo-keystrokes) (not (eq which-key-side-window-location 'bottom))) - full-prefix) + (concat full-prefix " ")) status-top " " nxt-pg-hint "\n" page))) ((eq which-key-show-prefix 'bottom) (setq page (concat page "\n" - (when (or (null echo-keystrokes) + (when (or (= 0 echo-keystrokes) (not (eq which-key-side-window-location 'bottom))) - full-prefix) + (concat full-prefix " ")) status-top " " nxt-pg-hint))) ((eq which-key-show-prefix 'echo) (which-key--echo (concat full-prefix @@ -1752,23 +1753,22 @@ after first page." prefix) if `which-key-use-C-h-commands' is non nil." (interactive) (let* ((prefix-keys (key-description which-key--current-prefix)) - (full-prefix (which-key--full-prefix prefix-keys)) - (k (string - (read-key - (concat (when (string-equal prefix-keys "") - (propertize " Top-level bindings" 'face 'which-key-note-face)) - full-prefix - (propertize - (substitute-command-keys - (concat - " \\" - " \\[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))))) - (cmd (lookup-key which-key-C-h-map k)) + (full-prefix (which-key--full-prefix prefix-keys current-prefix-arg)) + (prompt (concat (when (string-equal prefix-keys "") + (propertize " Top-level bindings" 'face 'which-key-note-face)) + full-prefix + (propertize + (substitute-command-keys + (concat + " \\" + " \\[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)))) commit 583416fda4c5d8b1196f5275d1113d915010a297 Author: Justin Burkett Date: Sat Dec 5 12:37:29 2015 -0500 Preserve prefx-arg when paging diff --git a/which-key.el b/which-key.el index f985a20b184..a7e86c963af 100644 --- a/which-key.el +++ b/which-key.el @@ -1508,23 +1508,24 @@ area." (propertize (format "[%s paging/help]" key) 'face 'which-key-note-face)))) -(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))))))) +(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) "Return a description of the full key sequence up to now, @@ -1637,6 +1638,12 @@ enough space based on your settings and frame size." prefix-keys) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; paging functions +(defun which-key--reload-key-sequence (key-seq) + (let ((next-event (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence 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. Will force an update if called before `which-key--update'." @@ -1644,19 +1651,15 @@ Will force an update if called before `which-key--update'." ;; No which-key buffer showing ((null which-key--current-page-n) (let* ((keysbl - (vconcat (butlast (append (this-single-command-keys) nil)))) - (next-event - (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence keysbl)))) - (setq unread-command-events next-event) + (vconcat (butlast (append (this-single-command-keys) nil))))) + (which-key--reload-key-sequence keysbl) (which-key--create-buffer-and-show keysbl))) ;; which-key buffer showing. turn page (t - (let ((next-event - (mapcar (lambda (ev) (cons t ev)) (which-key--current-key-list))) - (next-page + (let ((next-page (if which-key--current-page-n (+ which-key--current-page-n delta) 0))) - (setq unread-command-events next-event) + (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)) @@ -1729,8 +1732,7 @@ after first page." (which-key-inhibit t)) (if key-lst (progn - (setq unread-command-events - (mapcar (lambda (ev) (cons t ev)) key-lst)) + (which-key--reload-key-sequence key-lst) (which-key--create-buffer-and-show (apply #'vector key-lst))) (which-key-show-top-level)))) commit 0e87f61d72fd4b7a9cdb68ebc422307213dcd80e Author: Justin Burkett Date: Fri Dec 4 15:34:17 2015 -0500 Work on handling prefix args better diff --git a/which-key.el b/which-key.el index 323584ba339..f985a20b184 100644 --- a/which-key.el +++ b/which-key.el @@ -1450,9 +1450,9 @@ is the width of the live window." (max-lines (car max-dims)) (max-width (cdr max-dims)) (prefix-keys-desc (key-description which-key--current-prefix)) - (prefix-w-face (which-key--propertize-key prefix-keys-desc)) + (full-prefix (which-key--full-prefix prefix-keys-desc)) (prefix-left (when (eq which-key-show-prefix 'left) - (+ 2 (which-key--string-width prefix-w-face)))) + (+ 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)) @@ -1508,6 +1508,39 @@ area." (propertize (format "[%s paging/help]" key) 'face 'which-key-note-face)))) +(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) + "Return a description of the full key sequence up to now, +including prefix arguments." + (let* ((left (eq which-key-show-prefix 'left)) + (str (concat + (which-key--universal-argument--description) + (when prefix-arg " ") + prefix-keys)) + (dash (if (and which-key--current-prefix + (null left)) "-" ""))) + (if (eq which-key-show-prefix 'echo) + (concat str dash) + (concat (which-key--propertize-key str) + (propertize dash 'face 'which-key-key-face))))) + (defun which-key--get-popup-map () (unless which-key--current-prefix (let ((map (make-sparse-keymap))) @@ -1534,12 +1567,7 @@ enough space based on your settings and frame size." prefix-keys) (width (nth page-n (plist-get which-key--pages-plist :page-widths))) (n-shown (nth page-n (plist-get which-key--pages-plist :keys/page))) (n-tot (plist-get which-key--pages-plist :tot-keys)) - (prefix-w-face (if (eq which-key-show-prefix 'echo) prefix-keys - (which-key--propertize-key prefix-keys))) - (dash-w-face (if which-key--current-prefix - (if (eq which-key-show-prefix 'echo) "-" - (propertize "-" 'face 'which-key-key-face)) - "")) + (full-prefix (which-key--full-prefix prefix-keys)) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) (status-top (propertize (which-key--maybe-get-prefix-title @@ -1550,10 +1578,10 @@ enough space based on your settings and frame size." prefix-keys) (propertize (format " (%s of %s)" (1+ page-n) n-pages) 'face 'which-key-note-face)))) - (first-col-width (+ 2 (max (which-key--string-width prefix-w-face) + (first-col-width (+ 2 (max (which-key--string-width full-prefix) (which-key--string-width status-left)))) (prefix-left (format (concat "%-" (int-to-string first-col-width) "s") - prefix-w-face)) + full-prefix)) (status-left (format (concat "%-" (int-to-string first-col-width) "s") status-left)) (nxt-pg-hint (which-key--next-page-hint prefix-keys)) @@ -1577,7 +1605,7 @@ enough space based on your settings and frame size." prefix-keys) (concat (when (or (null echo-keystrokes) (not (eq which-key-side-window-location 'bottom))) - (concat prefix-w-face dash-w-face " ")) + full-prefix) status-top " " nxt-pg-hint "\n" page))) ((eq which-key-show-prefix 'bottom) (setq page @@ -1585,10 +1613,10 @@ enough space based on your settings and frame size." prefix-keys) page "\n" (when (or (null echo-keystrokes) (not (eq which-key-side-window-location 'bottom))) - (concat prefix-w-face dash-w-face " ")) + full-prefix) status-top " " nxt-pg-hint))) ((eq which-key-show-prefix 'echo) - (which-key--echo (concat prefix-w-face dash-w-face + (which-key--echo (concat full-prefix (when prefix-keys " ") status-top (when status-top " ") nxt-pg-hint)))) @@ -1722,17 +1750,12 @@ after first page." prefix) if `which-key-use-C-h-commands' is non nil." (interactive) (let* ((prefix-keys (key-description which-key--current-prefix)) - (prefix-w-face (if (eq which-key-show-prefix 'echo) prefix-keys - (which-key--propertize-key prefix-keys))) - (dash-w-face (if which-key--current-prefix - (if (eq which-key-show-prefix 'echo) "-" - (propertize "-" 'face 'which-key-key-face)) - "")) + (full-prefix (which-key--full-prefix prefix-keys)) (k (string (read-key (concat (when (string-equal prefix-keys "") (propertize " Top-level bindings" 'face 'which-key-note-face)) - prefix-w-face dash-w-face + full-prefix (propertize (substitute-command-keys (concat @@ -1742,7 +1765,7 @@ prefix) if `which-key-use-C-h-commands' is non nil." " \\[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))))) + 'face 'which-key-note-face))))) (cmd (lookup-key which-key-C-h-map k)) (which-key-inhibit t)) (if cmd (funcall cmd) (which-key-turn-page 0)))) commit b3b41792e808e64428b42e8d7f05e977d02fc01f Author: Justin Burkett Date: Fri Dec 4 14:21:17 2015 -0500 Make C-h command hint respect C-h-map commands diff --git a/which-key.el b/which-key.el index a875c23ce2f..323584ba339 100644 --- a/which-key.el +++ b/which-key.el @@ -1733,7 +1733,15 @@ prefix) if `which-key-use-C-h-commands' is non nil." (concat (when (string-equal prefix-keys "") (propertize " Top-level bindings" 'face 'which-key-note-face)) prefix-w-face dash-w-face - (propertize " [n]ext-page, [p]revious-page, [u]ndo-key, [h]elp, [a]bort" + (propertize + (substitute-command-keys + (concat + " \\" + " \\[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))))) (cmd (lookup-key which-key-C-h-map k)) (which-key-inhibit t)) commit 2c5bb54b58585108163f931f8029582c1404c4b3 Merge: 4fb75fa6eff baee0db96e8 Author: Justin Burkett Date: Thu Dec 3 20:51:52 2015 -0500 Merge branch 'master' of https://github.com/justbur/emacs-which-key commit 4fb75fa6eff6b6920f66a09170fae1744082d1e7 Author: Justin Burkett Date: Thu Dec 3 20:49:43 2015 -0500 Don't abort key seq after unbound key in C-h-map Allows to recover from accidentally pressing C-h. This commit also fixes some echo area problems that become apprent after introducing the C-h-map stuff diff --git a/which-key.el b/which-key.el index 57214df430a..a875c23ce2f 100644 --- a/which-key.el +++ b/which-key.el @@ -1489,7 +1489,7 @@ is the width of the live window." Slight delay gets around evil functions that clear the echo area." (let* ((minibuffer (eq which-key-popup-type 'minibuffer)) - (delay (if minibuffer 0.2 0.01)) + (delay (if minibuffer 0.2 (+ echo-keystrokes 0.001))) message-log-max) (unless minibuffer (message "%s" text)) (run-with-idle-timer @@ -1609,7 +1609,7 @@ enough space based on your settings and frame size." prefix-keys) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; paging functions -(defun which-key-turn-page (&optional backward) +(defun which-key-turn-page (delta) "Show the next page of keys. Will force an update if called before `which-key--update'." (cond @@ -1627,7 +1627,7 @@ Will force an update if called before `which-key--update'." (mapcar (lambda (ev) (cons t ev)) (which-key--current-key-list))) (next-page (if which-key--current-page-n - (+ which-key--current-page-n (if backward -1 1)) 0))) + (+ which-key--current-page-n delta) 0))) (setq unread-command-events next-event) (if which-key--last-try-2-loc (let ((which-key-side-window-location which-key--last-try-2-loc) @@ -1641,7 +1641,7 @@ Will force an update if called before `which-key--update'." "Call the command in `which-key--prefix-help-cmd-backup'. Usually this is `describe-prefix-bindings'." (interactive) - (let (which-key-inhibit) + (let ((which-key-inhibit t)) (which-key--hide-popup-ignore-command) (funcall which-key--prefix-help-cmd-backup))) @@ -1650,11 +1650,11 @@ Usually this is `describe-prefix-bindings'." "Show next page of keys unless on the last page, in which case call `which-key-show-standard-help'." (interactive) - (let (which-key-inhibit) + (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)))) + (which-key-turn-page 1)))) (defalias 'which-key-show-next-page 'which-key-show-next-page-no-cycle) (make-obsolete 'which-key-show-next-page 'which-key-show-next-page-no-cycle "2015-12-2") @@ -1664,27 +1664,27 @@ call `which-key-show-standard-help'." "Show previous page of keys unless on the first page, in which case do nothing." (interactive) - (let (which-key-inhibit) + (let ((which-key-inhibit t)) (if (and which-key--current-page-n (eq which-key--current-page-n 0)) - nil - (which-key-turn-page t)))) + (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) - (which-key-turn-page))) + (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) - (which-key-turn-page t))) + (let ((which-key-inhibit t)) + (which-key-turn-page -1))) ;;;###autoload (defun which-key-show-top-level () @@ -1698,7 +1698,7 @@ after first page." "Undo last keypress and force which-key update." (interactive) (let* ((key-lst (butlast (which-key--current-key-list))) - which-key-inhibit) + (which-key-inhibit t)) (if key-lst (progn (setq unread-command-events @@ -1711,7 +1711,7 @@ after first page." (defun which-key-abort () "Abort key sequence." (interactive) - (let (which-key-inhibit) + (let ((which-key-inhibit t)) (which-key--hide-popup-ignore-command) (message "Aborted key sequence"))) @@ -1736,8 +1736,8 @@ prefix) if `which-key-use-C-h-commands' is non nil." (propertize " [n]ext-page, [p]revious-page, [u]ndo-key, [h]elp, [a]bort" 'face 'which-key-note-face))))) (cmd (lookup-key which-key-C-h-map k)) - which-key-inhibit) - (if cmd (funcall cmd) (which-key-abort)))) + (which-key-inhibit t)) + (if cmd (funcall cmd) (which-key-turn-page 0)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update commit baee0db96e8a0235ec17f8caea2c32a434b87c30 Author: Justin Burkett Date: Thu Dec 3 12:10:47 2015 -0500 Clarify C-h commands description in readme diff --git a/README.org b/README.org index 80312e8b805..e6a94880ef2 100644 --- a/README.org +++ b/README.org @@ -2,11 +2,11 @@ [[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]] ** What's New - =C-h= commands! Now =C-h= will prompt you will several options instead of - going to the next page. You can (see =which-key-C-h-map=) + going directly to the next page. You can (see =which-key-C-h-map=) - 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=) - - Show the default command bound to =C-h= with =h= (or =C-h=) + - Call the default command bound to =C-h=, usually =describe-prefix-bindings=, with =h= (or =C-h=) This is a fairly substantial change and might introduce a bug or two, so please report anything you see that is strange and I will try to fix it. - Use your mouse to hover over commands and the docstring will be displayed in commit 318f9de6a921dee457cd8ab113f0f5bd78c858bf Author: Justin Burkett Date: Thu Dec 3 11:15:19 2015 -0500 Fix top-level note and satisfy compiler diff --git a/which-key.el b/which-key.el index f84461fad61..57214df430a 100644 --- a/which-key.el +++ b/which-key.el @@ -1149,7 +1149,7 @@ a replacement occurs return the new STRING." "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." - (if keys + (if (not (string-equal keys "")) (let* ((alist which-key-prefix-title-alist) (res (assoc-string keys alist)) (mode-alist (assq major-mode alist)) @@ -1496,7 +1496,7 @@ area." delay nil (lambda () (let (message-log-max) (message "%s" text)))))) -(defun which-key--next-page-hint (prefix-keys n-pages) +(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 @@ -1556,7 +1556,7 @@ enough space based on your settings and frame size." prefix-keys) prefix-w-face)) (status-left (format (concat "%-" (int-to-string first-col-width) "s") status-left)) - (nxt-pg-hint (which-key--next-page-hint prefix-keys n-pages)) + (nxt-pg-hint (which-key--next-page-hint prefix-keys)) new-end lines first) (cond ((and (< 1 n-pages) (eq which-key-show-prefix 'left)) @@ -1730,7 +1730,9 @@ prefix) if `which-key-use-C-h-commands' is non nil." "")) (k (string (read-key - (concat prefix-w-face dash-w-face + (concat (when (string-equal prefix-keys "") + (propertize " Top-level bindings" 'face 'which-key-note-face)) + prefix-w-face dash-w-face (propertize " [n]ext-page, [p]revious-page, [u]ndo-key, [h]elp, [a]bort" 'face 'which-key-note-face))))) (cmd (lookup-key which-key-C-h-map k)) commit 388c00736a6e93a7772d1ce9d27eaec96c159089 Author: Justin Burkett Date: Thu Dec 3 08:44:14 2015 -0500 Add C-h commands to what's new in readme Still need to update the rest of the content diff --git a/README.org b/README.org index c87080e6c52..80312e8b805 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,14 @@ * 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]] ** What's New +- =C-h= commands! Now =C-h= will prompt you will several options instead of + going to the next page. You can (see =which-key-C-h-map=) + - 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=) + - Show the default command bound to =C-h= with =h= (or =C-h=) + This is a fairly substantial change and might introduce a bug or two, so + please report anything you see that is strange and I will try to fix it. - Use your mouse to hover over commands and the docstring will be displayed in the echo area or a tooltip, depending on whether or not you're using =tooltip-mode=. @@ -323,6 +331,8 @@ available options. #+END_SRC *** Paging Options +[Note: This section is out of date given the new =C-h= commands feature +described in the What's New section. I will update it soon.]. 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 commit 5ebbe69cfb9067076f76f6085f3943b0d3d04b32 Author: Justin Burkett Date: Thu Dec 3 08:33:56 2015 -0500 Fix note on right and add abort keys diff --git a/which-key.el b/which-key.el index 3885826303f..f84461fad61 100644 --- a/which-key.el +++ b/which-key.el @@ -261,7 +261,9 @@ prefixes in `which-key-paging-prefixes'" (defvar which-key-C-h-map (let ((map (make-sparse-keymap))) - (dolist (bind '(("\C-h" . which-key-show-standard-help) + (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) @@ -1500,11 +1502,10 @@ area." (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 (or (and (< 1 n-pages) which-key-use-C-h-commands) - (and (< 1 n-pages) paging-key-bound)) + (when (and which-key-use-C-h-commands (not (and which-key-allow-evil-operators (bound-and-true-p evil-this-operator)))) - (propertize (format "[%s which-key cmds]" key) + (propertize (format "[%s paging/help]" key) 'face 'which-key-note-face)))) (defun which-key--get-popup-map () @@ -1707,11 +1708,12 @@ after first page." (which-key-show-top-level)))) (defalias 'which-key-undo 'which-key-undo-key) -(defun which-key-nil () +(defun which-key-abort () "Abort key sequence." (interactive) (let (which-key-inhibit) - (message "abort"))) + (which-key--hide-popup-ignore-command) + (message "Aborted key sequence"))) ;;;###autoload (defun which-key-C-h-dispatch () @@ -1729,11 +1731,11 @@ prefix) if `which-key-use-C-h-commands' is non nil." (k (string (read-key (concat prefix-w-face dash-w-face - (propertize " [n]ext-page, [p]revious-page, [u]ndo-key, [h]elp" + (propertize " [n]ext-page, [p]revious-page, [u]ndo-key, [h]elp, [a]bort" 'face 'which-key-note-face))))) (cmd (lookup-key which-key-C-h-map k)) which-key-inhibit) - (if cmd (funcall cmd) (which-key-nil)))) + (if cmd (funcall cmd) (which-key-abort)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update commit 9846929ddf094929e824f69cde222b7d7af0d851 Author: Justin Burkett Date: Thu Dec 3 08:10:50 2015 -0500 Fix undo and timer usage diff --git a/which-key.el b/which-key.el index 3a81d1f89bf..3885826303f 100644 --- a/which-key.el +++ b/which-key.el @@ -279,8 +279,9 @@ prefixes in `which-key-paging-prefixes'" 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-show-previous-page-no-cycle + which-key-undo-key + which-key-undo)) (defcustom which-key-prevent-C-h-from-cycling t "When using C-h for paging, which-key overrides the default @@ -1126,10 +1127,7 @@ replacement occurs return the new STRING." (listify-key-sequence (kbd key-str))))) (defsubst which-key--current-key-string (&optional key-str) - (key-description - (append (listify-key-sequence which-key--current-prefix) - (when key-str - (listify-key-sequence (kbd key-str)))))) + (key-description (which-key--current-key-list key-str))) (defun which-key--maybe-replace-prefix-name (keys desc) "KEYS is a list of keys produced by `listify-key-sequences' and @@ -1642,19 +1640,20 @@ Will force an update if called before `which-key--update'." "Call the command in `which-key--prefix-help-cmd-backup'. Usually this is `describe-prefix-bindings'." (interactive) - (which-key--hide-popup-ignore-command) - (funcall which-key--prefix-help-cmd-backup) - (which-key--start-timer)) + (let (which-key-inhibit) + (which-key--hide-popup-ignore-command) + (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) - (if (and which-key--current-page-n - which-key--on-last-page) - (which-key-show-standard-help) - (which-key-turn-page))) + (let (which-key-inhibit) + (if (and which-key--current-page-n + which-key--on-last-page) + (which-key-show-standard-help) + (which-key-turn-page)))) (defalias 'which-key-show-next-page 'which-key-show-next-page-no-cycle) (make-obsolete 'which-key-show-next-page 'which-key-show-next-page-no-cycle "2015-12-2") @@ -1664,24 +1663,27 @@ call `which-key-show-standard-help'." "Show previous page of keys unless on the first page, in which case do nothing." (interactive) - (if (and which-key--current-page-n - (eq which-key--current-page-n 0)) - nil - (which-key-turn-page t))) + (let (which-key-inhibit) + (if (and which-key--current-page-n + (eq which-key--current-page-n 0)) + nil + (which-key-turn-page t)))) ;;;###autoload (defun which-key-show-next-page-cycle () "Show the next page of keys, cycling from end to beginning after last page." (interactive) - (which-key-turn-page)) + (let (which-key-inhibit) + (which-key-turn-page))) ;;;###autoload (defun which-key-show-previous-page-cycle () "Show the previous page of keys, cycling from beginning to end after first page." (interactive) - (which-key-turn-page t)) + (let (which-key-inhibit) + (which-key-turn-page t))) ;;;###autoload (defun which-key-show-top-level () @@ -1694,22 +1696,22 @@ after first page." (defun which-key-undo-key () "Undo last keypress and force which-key update." (interactive) - (let* ((key-lst (butlast (which-key--current-key-list) 1))) + (let* ((key-lst (butlast (which-key--current-key-list))) + which-key-inhibit) (if key-lst (progn (setq unread-command-events (mapcar (lambda (ev) (cons t ev)) key-lst)) (which-key--create-buffer-and-show - (key-description key-lst))) - (which-key-show-top-level))) - (which-key--start-timer)) + (apply #'vector key-lst))) + (which-key-show-top-level)))) (defalias 'which-key-undo 'which-key-undo-key) (defun which-key-nil () "Abort key sequence." (interactive) - (message "abort") - (which-key--start-timer)) + (let (which-key-inhibit) + (message "abort"))) ;;;###autoload (defun which-key-C-h-dispatch () @@ -1731,7 +1733,6 @@ prefix) if `which-key-use-C-h-commands' is non nil." 'face 'which-key-note-face))))) (cmd (lookup-key which-key-C-h-map k)) which-key-inhibit) - (which-key--stop-timer) (if cmd (funcall cmd) (which-key-nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1813,6 +1814,7 @@ Finally, show the buffer." (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 () commit b5ec6f8f8d95104fd1ffb397f15aa0b818b1c272 Author: Justin Burkett Date: Wed Dec 2 22:27:08 2015 -0500 Introduce C-h command dispatch function Replace role of show-next-page with C-h-dispatch which immediately reads a key and calls a command from C-h-map, which may be one of several paging commands, a command to undo the last keypress, or a command to directly access describe-prefix-bindings. This commit does not include documenting these changes in the readme. Note that several options become deprecated here as they no longer have the same (if any effect). diff --git a/which-key.el b/which-key.el index 57f475368cd..3a81d1f89bf 100644 --- a/which-key.el +++ b/which-key.el @@ -247,12 +247,40 @@ prefixes in `which-key-paging-prefixes'" ;; :group 'which-key ;; :type '(repeat symbol)) -(defcustom which-key-use-C-h-for-paging t +(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) +(defvaralias 'which-key-use-C-h-for-paging + 'which-key-use-C-h-commands) +(make-obsolete-variable 'which-key-use-C-h-for-paging + 'which-key-use-C-h-commands + "2015-12-2") + +(defvar which-key-C-h-map + (let ((map (make-sparse-keymap))) + (dolist (bind '(("\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 + 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)) + (defcustom which-key-prevent-C-h-from-cycling t "When using C-h for paging, which-key overrides the default @@ -262,6 +290,9 @@ prefixes in `which-key-paging-prefixes'" want which-key to cycle, set this to nil." :group 'which-key :type 'boolean) +(make-obsolete-variable 'which-key-prevent-C-h-from-cycling + "No longer applies. See `which-key-C-h-dispatch'" + "2015-12-2") (defcustom which-key-allow-evil-operators (boundp 'evil-this-operator) "Allow popup to show for evil operators. The popup is normally @@ -422,17 +453,17 @@ alongside the actual current key sequence when (lambda (prefix) (define-key map (kbd (concat prefix " " which-key-paging-key)) - #'which-key-show-next-page)) + #'which-key-C-h-dispatch)) which-key-paging-prefixes) map) (if which-key-mode (progn (setq which-key--echo-keystrokes-backup echo-keystrokes) (unless which-key--is-setup (which-key--setup)) - (unless (eq prefix-help-command 'which-key-show-next-page) + (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-for-paging - (setq prefix-help-command #'which-key-show-next-page)) + (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) @@ -502,13 +533,6 @@ starter kit for example." (setq which-key-key-replacement-alist (delete '("right" . "→") which-key-key-replacement-alist))) -;; (defun which-key--setup-undo-key () -;; "Bind `which-key-undo-key' in `which-key-undo-keymaps'." -;; (when (and which-key-undo-key which-key-undo-keymaps) -;; (dolist (map which-key-undo-keymaps) -;; (which-key-define-key-recursively -;; map (kbd which-key-undo-key) 'which-key-undo)))) - ;; (defun which-key--check-key-based-alist () ;; "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'" ;; (let ((alist which-key-key-based-description-replacement-alist) @@ -781,7 +805,7 @@ total height." (defun which-key--hide-popup () "This function is called to hide the which-key buffer." - (unless (eq real-this-command 'which-key-show-next-page) + (unless (member real-this-command which-key--paging-functions) (setq which-key--current-page-n nil which-key--using-top-level nil which-key--on-last-page nil) @@ -1472,31 +1496,26 @@ area." delay nil (lambda () (let (message-log-max) (message "%s" text)))))) -(defun which-key--next-page-hint (prefix-keys page-n n-pages) +(defun which-key--next-page-hint (prefix-keys n-pages) "Return string for next page hint." (let* ((paging-key (concat prefix-keys " " which-key-paging-key)) - (paging-key-bound (eq 'which-key-show-next-page + (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")) - (next-page-n (format "pg %s" (1+ (mod (1+ page-n) n-pages)))) - (use-descbind (and which-key--on-last-page which-key-use-C-h-for-paging - which-key-prevent-C-h-from-cycling))) - (when (and (or (and (< 1 n-pages) which-key-use-C-h-for-paging) - (and (< 1 n-pages) paging-key-bound) - use-descbind) + (key (if paging-key-bound which-key-paging-key "C-h"))) + (when (and (or (and (< 1 n-pages) which-key-use-C-h-commands) + (and (< 1 n-pages) paging-key-bound)) (not (and which-key-allow-evil-operators (bound-and-true-p evil-this-operator)))) - (propertize (format "[%s %s]" key - (if use-descbind "help" next-page-n)) + (propertize (format "[%s which-key cmds]" key) 'face 'which-key-note-face)))) (defun which-key--get-popup-map () (unless which-key--current-prefix (let ((map (make-sparse-keymap))) - (define-key map (kbd which-key-paging-key) #'which-key-show-next-page) - (when which-key-use-C-h-for-paging + (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-show-next-page)) + (define-key map (kbd "C-h") #'which-key-C-h-dispatch)) map))) (defun which-key--show-page (n) @@ -1538,7 +1557,7 @@ enough space based on your settings and frame size." prefix-keys) prefix-w-face)) (status-left (format (concat "%-" (int-to-string first-col-width) "s") status-left)) - (nxt-pg-hint (which-key--next-page-hint prefix-keys page-n n-pages)) + (nxt-pg-hint (which-key--next-page-hint prefix-keys n-pages)) new-end lines first) (cond ((and (< 1 n-pages) (eq which-key-show-prefix 'left)) @@ -1588,37 +1607,28 @@ enough space based on your settings and frame size." prefix-keys) (with-no-warnings (set-temporary-overlay-map (which-key--get-popup-map)))))) -(defun which-key-show-next-page () +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; paging functions + +(defun which-key-turn-page (&optional backward) "Show the next page of keys. Will force an update if called before `which-key--update'." - (interactive) (cond - ;; on last page and want default C-h behavior - ((and which-key--current-page-n - which-key--on-last-page - which-key-use-C-h-for-paging - which-key-prevent-C-h-from-cycling) - (which-key--hide-popup-ignore-command) - (which-key--stop-timer) - (funcall which-key--prefix-help-cmd-backup) - (which-key--start-timer)) ;; No which-key buffer showing ((null which-key--current-page-n) (let* ((keysbl (vconcat (butlast (append (this-single-command-keys) nil)))) (next-event (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence keysbl)))) - (which-key--stop-timer) (setq unread-command-events next-event) - (which-key--create-buffer-and-show keysbl) - (which-key--start-timer))) + (which-key--create-buffer-and-show keysbl))) ;; which-key buffer showing. turn page (t (let ((next-event (mapcar (lambda (ev) (cons t ev)) (which-key--current-key-list))) (next-page - (if which-key--current-page-n (1+ which-key--current-page-n) 0))) - (which-key--stop-timer) + (if which-key--current-page-n + (+ which-key--current-page-n (if backward -1 1)) 0))) (setq unread-command-events next-event) (if which-key--last-try-2-loc (let ((which-key-side-window-location which-key--last-try-2-loc) @@ -1627,6 +1637,52 @@ Will force an update if called before `which-key--update'." (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) + (which-key--hide-popup-ignore-command) + (funcall which-key--prefix-help-cmd-backup) + (which-key--start-timer)) + +;;;###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) + (if (and which-key--current-page-n + which-key--on-last-page) + (which-key-show-standard-help) + (which-key-turn-page))) +(defalias 'which-key-show-next-page 'which-key-show-next-page-no-cycle) +(make-obsolete 'which-key-show-next-page 'which-key-show-next-page-no-cycle + "2015-12-2") + +;;;###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) + (if (and which-key--current-page-n + (eq which-key--current-page-n 0)) + nil + (which-key-turn-page t))) + +;;;###autoload +(defun which-key-show-next-page-cycle () + "Show the next page of keys, cycling from end to beginning +after last page." + (interactive) + (which-key-turn-page)) + +;;;###autoload +(defun which-key-show-previous-page-cycle () + "Show the previous page of keys, cycling from beginning to end +after first page." + (interactive) + (which-key-turn-page t)) + ;;;###autoload (defun which-key-show-top-level () "Show top-level bindings." @@ -1634,16 +1690,49 @@ Will force an update if called before `which-key--update'." (setq which-key--using-top-level t) (which-key--create-buffer-and-show nil)) -(defun which-key-undo () +;;;###autoload +(defun which-key-undo-key () "Undo last keypress and force which-key update." (interactive) - (let* ((key-str (this-command-keys)) - (key-str (substring key-str 0 (- (length key-str) 2))) - (ev (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence key-str)))) + (let* ((key-lst (butlast (which-key--current-key-list) 1))) + (if key-lst + (progn + (setq unread-command-events + (mapcar (lambda (ev) (cons t ev)) key-lst)) + (which-key--create-buffer-and-show + (key-description key-lst))) + (which-key-show-top-level))) + (which-key--start-timer)) +(defalias 'which-key-undo 'which-key-undo-key) + +(defun which-key-nil () + "Abort key sequence." + (interactive) + (message "abort") + (which-key--start-timer)) + +;;;###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) + (let* ((prefix-keys (key-description which-key--current-prefix)) + (prefix-w-face (if (eq which-key-show-prefix 'echo) prefix-keys + (which-key--propertize-key prefix-keys))) + (dash-w-face (if which-key--current-prefix + (if (eq which-key-show-prefix 'echo) "-" + (propertize "-" 'face 'which-key-key-face)) + "")) + (k (string + (read-key + (concat prefix-w-face dash-w-face + (propertize " [n]ext-page, [p]revious-page, [u]ndo-key, [h]elp" + 'face 'which-key-note-face))))) + (cmd (lookup-key which-key-C-h-map k)) + which-key-inhibit) (which-key--stop-timer) - (setq unread-command-events ev) - (which-key--create-buffer-and-show key-str) - (which-key--start-timer))) + (if cmd (funcall cmd) (which-key-nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update @@ -1727,7 +1816,7 @@ Finally, show the buffer." (setq which-key--paging-timer (run-with-idle-timer 0.2 t (lambda () - (when (or (not (eq real-last-command 'which-key-show-next-page)) + (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))))) commit 3327e9cdf2f9ee8e94501137401a5200db6bdbf3 Author: Justin Burkett Date: Tue Dec 1 11:53:02 2015 -0500 Remove dependencies from README diff --git a/README.org b/README.org index c0e7e93e3a5..c87080e6c52 100644 --- a/README.org +++ b/README.org @@ -39,7 +39,6 @@ Many of these have been implemented and are described below. - [[#install][Install]] - [[#melpa][MELPA]] - [[#manually][Manually]] - - [[#dependencies][Dependencies]] - [[#initial-setup][Initial Setup]] - [[#side-window-bottom-option][Side Window Bottom Option]] - [[#side-window-right-option][Side Window Right Option]] @@ -81,11 +80,6 @@ Add which-key.el to your =load-path= and require. Something like (which-key-mode) #+END_SRC -**** Dependencies - -Which-key requires recent versions of the packages [[https://github.com/magnars/dash.el][dash]] and [[https://github.com/magnars/s.el][s]]. These are -installed automatically if installed via MELPA. - ** 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 commit db97a29be52d2a9d6ac096fd12783976cca45b2b Author: Justin Burkett Date: Mon Nov 30 20:58:48 2015 -0500 Cleanup make-text-button call diff --git a/which-key.el b/which-key.el index 04bc4ef9a46..57f475368cd 100644 --- a/which-key.el +++ b/which-key.el @@ -1218,26 +1218,24 @@ ORIGINAL-DESCRIPTION is the description given by (substring desc 6) desc)) (desc (if group (concat "+" desc) desc)) (desc (which-key--truncate-description desc))) - (eval - `(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 (fboundp (intern original-description)) - (documentation (intern original-description)) - tooltip-mode) - (documentation (intern original-description))) - ((and (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))))))) + (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 (fboundp (intern original-description)) + (documentation (intern original-description)) + tooltip-mode) + (documentation (intern original-description))) + ((and (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--format-and-replace (unformatted) commit 7a30f4d4431ca155a14d1920cfae2fd04da52676 Author: Justin Burkett Date: Mon Nov 30 18:43:09 2015 -0500 Fix return value problem for make-text-button Apparently in versions before 24.5 the return value was not always the button itself when a string was used as the argument diff --git a/which-key.el b/which-key.el index 758fd00f554..04bc4ef9a46 100644 --- a/which-key.el +++ b/which-key.el @@ -1237,7 +1237,8 @@ ORIGINAL-DESCRIPTION is the description given by (max (floor (* (frame-width) 0.8)))) (if (> (length str) max) (concat (substring str 0 max) "...") - str))))))))) + str))))))) + desc)) (defun which-key--format-and-replace (unformatted) "Take a list of (key . desc) cons cells in UNFORMATTED, add commit d4b4bad88a9902afb370a43a6e372274ec3d5fd6 Merge: 70a47168798 2f4c5d8609c Author: Justin Burkett Date: Mon Nov 30 13:47:27 2015 -0500 Merge branch 'grammati' commit 70a471687987e832137961069be7dd2cbb9ab1c9 Author: Justin Burkett Date: Mon Nov 30 13:26:19 2015 -0500 Use safe version of string-width diff --git a/which-key.el b/which-key.el index f5e5c79dd54..ab9be1f22db 100644 --- a/which-key.el +++ b/which-key.el @@ -1073,6 +1073,10 @@ coming before a prefix. Within these categories order using ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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))) @@ -1170,7 +1174,8 @@ If KEY contains any \"special keys\" defined in (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 (string-width key-w-face)))) + (substring key-w-face end + (which-key--string-width key-w-face)))) key-w-face)))) (defsubst which-key--truncate-description (desc) @@ -1352,7 +1357,8 @@ BUFFER that follow the key sequence KEY-SEQ." "Internal function for finding the max length of the INDEX element in each list element of KEYS." (cl-reduce - (lambda (x y) (max x (string-width (nth index y)))) keys :initial-value 0)) + (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, @@ -1422,7 +1428,7 @@ is the width of the live window." (prefix-keys-desc (key-description which-key--current-prefix)) (prefix-w-face (which-key--propertize-key prefix-keys-desc)) (prefix-left (when (eq which-key-show-prefix 'left) - (+ 2 (string-width prefix-w-face)))) + (+ 2 (which-key--string-width prefix-w-face)))) (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)) @@ -1526,8 +1532,8 @@ enough space based on your settings and frame size." prefix-keys) (propertize (format " (%s of %s)" (1+ page-n) n-pages) 'face 'which-key-note-face)))) - (first-col-width (+ 2 (max (string-width prefix-w-face) - (string-width status-left)))) + (first-col-width (+ 2 (max (which-key--string-width prefix-w-face) + (which-key--string-width status-left)))) (prefix-left (format (concat "%-" (int-to-string first-col-width) "s") prefix-w-face)) (status-left (format (concat "%-" (int-to-string first-col-width) "s") commit 2f4c5d8609cc31bb7212126dcaf45dd55d21880a Author: Justin Burkett Date: Mon Nov 30 11:23:50 2015 -0500 Use key-description for canonical keys This takes the idea in the previous commit and translates the representations of keys in the alists to be the output of key-description. The issue is that `M-x` for example has two representations with listify-key-sequence, but only one (it seems) from key-description. diff --git a/which-key.el b/which-key.el index fc82da92e90..b72de6f545c 100644 --- a/which-key.el +++ b/which-key.el @@ -400,15 +400,15 @@ variable.") (defvar which-key-prefix-name-alist '() "An alist with elements of the form (key-sequence . prefix-name). -key-sequence is a sequence of the sort produced by applying `kbd' -then `listify-key-sequence' to create a canonical version of the -key sequence. prefix-name is a string.") +key-sequence is a sequence of the sort produced by applying +`key-description' to create a canonical version of the key +sequence. prefix-name is a string.") (defvar which-key-prefix-title-alist '() "An alist with elements of the form (key-sequence . prefix-title). -key-sequence is a sequence of the sort produced by applying `kbd' -then `listify-key-sequence' to create a canonical version of the -key sequence. prefix-title is a string. The title is displayed +key-sequence is a sequence of the sort produced by applying +`key-description' to create a canonical version of the key +sequence. prefix-title is a string. The title is displayed alongside the actual current key sequence when `which-key-show-prefix' is set to either top or echo.") @@ -470,7 +470,7 @@ set too high) and setup which-key buffer." (when (or (eq which-key-show-prefix 'echo) (eq which-key-popup-type 'minibuffer)) (which-key--setup-echo-keystrokes)) - (which-key--check-key-based-alist) + ;; (which-key--check-key-based-alist) ;; (which-key--setup-undo-key) (which-key--init-buffer) (setq which-key--is-setup t)) @@ -509,35 +509,35 @@ starter kit for example." ;; (which-key-define-key-recursively ;; map (kbd which-key-undo-key) 'which-key-undo)))) -(defun which-key--check-key-based-alist () - "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'" - (let ((alist which-key-key-based-description-replacement-alist) - old-style res) - (dolist (cns alist) - (cond ((listp (car cns)) - (push cns res)) - ((stringp (car cns)) - (setq old-style t) - (push (cons (listify-key-sequence (kbd (car cns))) (cdr cns)) res)) - ((symbolp (car cns)) - (let (new-mode-alist) - (dolist (cns2 (cdr cns)) - (cond ((listp (car cns2)) - (push cns2 new-mode-alist)) - ((stringp (car cns2)) - (setq old-style t) - (push (cons (listify-key-sequence (kbd (car cns2))) (cdr cns2)) - new-mode-alist)))) - (push (cons (car cns) new-mode-alist) res))) - (t (message "which-key: there's a problem with the \ -entry %s in which-key-key-based-replacement-alist" cns)))) - (setq which-key-key-based-description-replacement-alist res) - (when old-style - (message "which-key: \ - `which-key-key-based-description-replacement-alist' has changed format and you\ - seem to be using the old format. Please use the functions \ -`which-key-add-key-based-replacements' and \ -`which-key-add-major-mode-key-based-replacements' instead.")))) +;; (defun which-key--check-key-based-alist () +;; "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'" +;; (let ((alist which-key-key-based-description-replacement-alist) +;; old-style res) +;; (dolist (cns alist) +;; (cond ((listp (car cns)) +;; (push cns res)) +;; ((stringp (car cns)) +;; (setq old-style t) +;; (push (cons (listify-key-sequence (kbd (car cns))) (cdr cns)) res)) +;; ((symbolp (car cns)) +;; (let (new-mode-alist) +;; (dolist (cns2 (cdr cns)) +;; (cond ((listp (car cns2)) +;; (push cns2 new-mode-alist)) +;; ((stringp (car cns2)) +;; (setq old-style t) +;; (push (cons (listify-key-sequence (kbd (car cns2))) (cdr cns2)) +;; new-mode-alist)))) +;; (push (cons (car cns) new-mode-alist) res))) +;; (t (message "which-key: there's a problem with the \ +;; entry %s in which-key-key-based-replacement-alist" cns)))) +;; (setq which-key-key-based-description-replacement-alist res) +;; (when old-style +;; (message "which-key: \ +;; `which-key-key-based-description-replacement-alist' has changed format and you\ +;; seem to be using the old format. Please use the functions \ +;; `which-key-add-key-based-replacements' and \ +;; `which-key-add-major-mode-key-based-replacements' instead.")))) ;; Default configuration functions for use by users. Should be the "best" ;; configurations @@ -584,15 +584,15 @@ bottom." (when (or (not (stringp key)) (not (stringp value))) (error "which-key: Error %s (key) and %s (value) should be strings" key value)) - (let ((key-lst (listify-key-sequence (kbd key)))) - (cond ((null alist) (list (cons key-lst value))) - ((assoc key-lst alist) - (when (not (string-equal (cdr (assoc key-lst alist)) value)) + (let ((keys (key-description (kbd key)))) + (cond ((null alist) (list (cons keys value))) + ((assoc-string keys alist) + (when (not (string-equal (cdr (assoc-string keys alist)) value)) (message "which-key: changing %s name from %s to %s in the %s alist" - key (cdr (assoc key-lst alist)) value alist-name) - (setcdr (assoc key-lst alist) value)) + key (cdr (assoc-string keys alist)) value alist-name) + (setcdr (assoc-string keys alist) value)) alist) - (t (cons (cons key-lst value) alist))))) + (t (cons (cons keys value) alist))))) ;;;###autoload (defun which-key-add-key-based-replacements (key-sequence replacement &rest more) @@ -641,11 +641,11 @@ Add title for KEY-SEQ-STR given by TITLE. FORCE, if non-nil, will add the new title even if one already exists. KEY-SEQ-STR should be a key sequence string suitable for `kbd' and TITLE should be a string." - (let ((key-seq-lst (listify-key-sequence (kbd key-seq-str)))) + (let ((keys (key-description (kbd key-seq-str)))) (if (and (null force) - (assoc key-seq-lst which-key-prefix-title-alist)) + (assoc-string keys which-key-prefix-title-alist)) (message "which-key: Prefix title not added. A title exists for this prefix.") - (push (cons key-seq-lst title) which-key-prefix-title-alist)))) + (push (cons keys title) which-key-prefix-title-alist)))) ;;;###autoload (defun which-key-declare-prefixes (key-sequence name &rest more) @@ -1103,30 +1103,31 @@ replacement occurs return the new STRING." (when key-str (listify-key-sequence (kbd key-str)))))) -(defun which-key--maybe-replace-prefix-name (key-lst desc) - "KEY-LST is a list of keys produced by `listify-key-sequences' -and DESC is the description that is possibly replaced using the -`which-key-prefix-name-alist'. Whether or not a replacement -occurs return the new STRING." +(defun which-key--maybe-replace-prefix-name (keys desc) + "KEYS is a list of keys produced by `listify-key-sequences' and +`key-description'. DESC is the description that is possibly +replaced using the `which-key-prefix-name-alist'. Whether or not +a replacement occurs return the new STRING." (let* ((alist which-key-prefix-name-alist) - (canonical-key-lst (listify-key-sequence (kbd (key-description key-lst)))) - (res (assoc canonical-key-lst alist)) + (res (assoc-string keys alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc canonical-key-lst mode-alist)))) + (mode-res (when mode-alist + (assoc-string keys mode-alist)))) (cond (mode-res (cdr mode-res)) (res (cdr res)) (t desc)))) -(defun which-key--maybe-get-prefix-title (key-lst) - "KEY-LST is a list of keys produced by `listify-key-sequences'. +(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." - (if key-lst + (if keys (let* ((alist which-key-prefix-title-alist) - (res (assoc key-lst alist)) + (res (assoc-string keys alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc key-lst mode-alist))) - (binding (key-binding (apply #'vector key-lst))) + (mode-res (when mode-alist + (assoc-string keys mode-alist))) + (binding (key-binding keys)) (alternate (when (and binding (symbolp binding)) (symbol-name binding)))) (cond (mode-res (cdr mode-res)) @@ -1137,19 +1138,19 @@ An empty stiring is returned if no title exists." (eq which-key-side-window-location 'bottom) echo-keystrokes) (if alternate alternate - (concat "Following " (key-description key-lst)))) + (concat "Following " keys))) (t ""))) "Top-level bindings")) -(defun which-key--maybe-replace-key-based (string key-lst) - "KEY-LST is a list of keys produced by `listify-key-sequences' +(defun which-key--maybe-replace-key-based (string keys) + "KEYS is a string produced by `key-description' and STRING is the description that is possibly replaced using the `which-key-key-based-description-replacement-alist'. Whether or not a replacement occurs return the new STRING." (let* ((alist which-key-key-based-description-replacement-alist) - (str-res (assoc key-lst alist)) + (str-res (assoc-string keys alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc key-lst mode-alist)))) + (mode-res (when mode-alist (assoc-string keys mode-alist)))) (cond (mode-res (cdr mode-res)) (str-res (cdr str-res)) (t string)))) @@ -1246,7 +1247,6 @@ alists. Returns a list (key separator description)." (orig-desc (cdr key-desc-cons)) (group (which-key--group-p orig-desc)) (keys (which-key--current-key-string key)) - (key-lst (which-key--current-key-list key)) (local (eq (which-key--safe-lookup-key local-map (kbd keys)) (intern orig-desc))) (hl-face (which-key--highlight-face orig-desc)) @@ -1254,9 +1254,9 @@ alists. Returns a list (key separator description)." key which-key-key-replacement-alist)) (desc (which-key--maybe-replace orig-desc which-key-description-replacement-alist)) - (desc (which-key--maybe-replace-key-based desc key-lst)) + (desc (which-key--maybe-replace-key-based desc keys)) (desc (if group - (which-key--maybe-replace-prefix-name key-lst desc) + (which-key--maybe-replace-prefix-name keys desc) desc)) (key-w-face (which-key--propertize-key key)) (desc-w-face (which-key--propertize-description @@ -1520,7 +1520,7 @@ enough space based on your settings and frame size." prefix-keys) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) (status-top (propertize (which-key--maybe-get-prefix-title - (which-key--current-key-list)) + (which-key--current-key-string)) 'face 'which-key-note-face)) (status-top (concat status-top (when (< 1 n-pages) commit ead6b70fd0910ead6db01ac8762918f48b6a5e5c Author: Chris Perkins Date: Sat Nov 28 11:15:21 2015 -0700 Display prefix names in terminal-mode When running emacs in a terminal (or at least, in iTerm), keys are not passed through to emacs the same way that they are in graphical mode. For example, M-m (important in spacemacs) is the key-sequence `[134217837]` in graphical emacs, but `[27 109]` ("ESC m") in terminal. The variable `which-key-prefix-name-alst` only has a mapping for the former (the 134217837), and so the names of submenus all show up as "+prefix", limiting discoverability. This commit converts the key sequence into a canonical form (eg: converts `[27 109]` into `[134217837]`) in `which-key--maybe-replace-prefix-name`, so that the prefixes are found. I think some work is probably needed for `which-key-prefix-title-alist` too, but I'm not entirely sure what that's used for, so I didn't mess with it. diff --git a/which-key.el b/which-key.el index f5e5c79dd54..fc82da92e90 100644 --- a/which-key.el +++ b/which-key.el @@ -1109,9 +1109,10 @@ and DESC is the description that is possibly replaced using the `which-key-prefix-name-alist'. Whether or not a replacement occurs return the new STRING." (let* ((alist which-key-prefix-name-alist) - (res (assoc key-lst alist)) + (canonical-key-lst (listify-key-sequence (kbd (key-description key-lst)))) + (res (assoc canonical-key-lst alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc key-lst mode-alist)))) + (mode-res (when mode-alist (assoc canonical-key-lst mode-alist)))) (cond (mode-res (cdr mode-res)) (res (cdr res)) (t desc)))) commit 2d0b1463adabedf679efa8257ff1cb3555808cf1 Author: Justin Burkett Date: Fri Nov 20 15:40:16 2015 -0500 Add README note about last commit diff --git a/README.org b/README.org index f785d2024e1..c0e7e93e3a5 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,9 @@ * 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]] ** What's New +- Use your mouse to hover over commands and the docstring will be displayed in + the echo area or a tooltip, depending on whether or not you're using + =tooltip-mode=. - The function =which-key-show-top-level= was implemented by @iqbalansari (thanks!) to show top-level key bindings (those not behind a prefix). You can use =M-x which-key-show-top-level= to try it and bind it to a key if you like. commit 55384945c7623536f6577d86b36357fff653d4dd Author: Justin Burkett Date: Fri Nov 20 15:23:40 2015 -0500 Show docstring on hover in echo area for commands diff --git a/which-key.el b/which-key.el index 0c7860e1513..f5e5c79dd54 100644 --- a/which-key.el +++ b/which-key.el @@ -39,6 +39,7 @@ ;;; Code: (require 'cl-lib) +(require 'button) (eval-when-compile (defvar golden-ratio-mode)) @@ -1196,21 +1197,40 @@ 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) +(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." +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 "+" desc) desc)) (desc (which-key--truncate-description desc))) - (propertize desc '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))))) + (eval + `(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 (fboundp (intern original-description)) + (documentation (intern original-description)) + tooltip-mode) + (documentation (intern original-description))) + ((and (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))))))))) (defun which-key--format-and-replace (unformatted) "Take a list of (key . desc) cons cells in UNFORMATTED, add @@ -1222,23 +1242,24 @@ alists. Returns a list (key separator description)." (mapcar (lambda (key-desc-cons) (let* ((key (car key-desc-cons)) - (desc (cdr key-desc-cons)) - (group (which-key--group-p desc)) + (orig-desc (cdr key-desc-cons)) + (group (which-key--group-p orig-desc)) (keys (which-key--current-key-string key)) (key-lst (which-key--current-key-list key)) (local (eq (which-key--safe-lookup-key local-map (kbd keys)) - (intern desc))) - (hl-face (which-key--highlight-face desc)) + (intern orig-desc))) + (hl-face (which-key--highlight-face orig-desc)) (key (which-key--maybe-replace key which-key-key-replacement-alist)) (desc (which-key--maybe-replace - desc which-key-description-replacement-alist)) + orig-desc which-key-description-replacement-alist)) (desc (which-key--maybe-replace-key-based desc key-lst)) (desc (if group (which-key--maybe-replace-prefix-name key-lst desc) desc)) (key-w-face (which-key--propertize-key key)) - (desc-w-face (which-key--propertize-description desc group local hl-face))) + (desc-w-face (which-key--propertize-description + desc group local hl-face orig-desc))) (list key-w-face sep-w-face desc-w-face))) unformatted))) commit 3fceb99ee4300ad5bf711f7113872a1dabe22301 Author: Justin Burkett Date: Fri Nov 20 06:34:01 2015 -0500 Fix mistake in reverting defaults Ref 9dd0ceaaabe6b4ac5f3268747b6103fb04d65e5f Accidentally changed the side window location instead of the show-prefix one. diff --git a/which-key.el b/which-key.el index 18b277ecda1..0c7860e1513 100644 --- a/which-key.el +++ b/which-key.el @@ -139,7 +139,7 @@ and have `which-key-special-key-face' applied to them." :group 'which-key :type 'string) -(defcustom which-key-show-prefix 'bottom +(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." commit b61c7ad564049e6bbd577063f40dbbfe91cefc4d Merge: cd6b3c5e99d 62344270c58 Author: Justin Burkett Date: Fri Nov 20 06:31:17 2015 -0500 Merge pull request #87 from cute-jumper/master Fix the value of `which-key-side-window-location' commit 62344270c58abc1ca65fba65f5c1f4a1d81b493e Author: Junpeng Qiu Date: Thu Nov 19 22:52:43 2015 -0500 Fix the value of `which-key-side-window-location' diff --git a/which-key.el b/which-key.el index 7347fad3723..18b277ecda1 100644 --- a/which-key.el +++ b/which-key.el @@ -164,7 +164,7 @@ and nil. Nil turns the feature off." :group 'which-key :type 'integer) -(defcustom which-key-side-window-location 'echo +(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 commit cd6b3c5e99d371c08185aca6d333d0f0f278c666 Author: Justin Burkett Date: Wed Nov 18 22:04:29 2015 -0500 Check for nil as a binding in previous commit diff --git a/which-key.el b/which-key.el index aaef402b459..7347fad3723 100644 --- a/which-key.el +++ b/which-key.el @@ -1124,8 +1124,9 @@ An empty stiring is returned if no title exists." (res (assoc key-lst alist)) (mode-alist (assq major-mode alist)) (mode-res (when mode-alist (assoc key-lst mode-alist))) - (alternate (when (symbolp (key-binding (apply #'vector key-lst))) - (symbol-name (key-binding (apply #'vector key-lst)))))) + (binding (key-binding (apply #'vector key-lst))) + (alternate (when (and binding (symbolp binding)) + (symbol-name binding)))) (cond (mode-res (cdr mode-res)) (res (cdr res)) ((and (eq which-key-show-prefix 'echo) alternate) commit c6abc78b5825b13febeee662433dbd7bb53d98e1 Author: Justin Burkett Date: Wed Nov 18 22:00:14 2015 -0500 Provide alternate prefix-title for echo area diff --git a/which-key.el b/which-key.el index 490ed7db277..aaef402b459 100644 --- a/which-key.el +++ b/which-key.el @@ -1123,14 +1123,17 @@ An empty stiring is returned if no title exists." (let* ((alist which-key-prefix-title-alist) (res (assoc key-lst alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc key-lst mode-alist)))) + (mode-res (when mode-alist (assoc key-lst mode-alist))) + (alternate (when (symbolp (key-binding (apply #'vector key-lst))) + (symbol-name (key-binding (apply #'vector key-lst)))))) (cond (mode-res (cdr mode-res)) (res (cdr 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 (symbolp (key-binding (apply #'vector key-lst))) - (symbol-name (key-binding (apply #'vector key-lst))) + (if alternate alternate (concat "Following " (key-description key-lst)))) (t ""))) "Top-level bindings")) commit 6b5ca75b648e256bf2da5d5b0341abb27a198484 Author: Justin Burkett Date: Wed Nov 18 21:48:27 2015 -0500 Forgot line in last commit diff --git a/which-key.el b/which-key.el index 5e68f5c4cda..490ed7db277 100644 --- a/which-key.el +++ b/which-key.el @@ -563,6 +563,7 @@ if there is space and the bottom otherwise." "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)) commit 9dd0ceaaabe6b4ac5f3268747b6103fb04d65e5f Author: Justin Burkett Date: Wed Nov 18 21:44:11 2015 -0500 Revert change in default of side-window-bottom Not happy with the look of it yet, even though it's probably better to avoid the echo area diff --git a/README.org b/README.org index bf56704cdfc..f785d2024e1 100644 --- a/README.org +++ b/README.org @@ -1,17 +1,6 @@ * 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]] ** What's New -- Implemented =bottom= as an option for =which-key-show-prefix=, which will show - the key, page number, and next page key information on the last line of the - which-key buffer. -- This is the new default for =which-key-setup-side-window-bottom=. The old - default, which is still available, used the echo area for this information. - The echo area is not a good default, because it's not possible to completely - control what shows there without doing something ugly, so occasionally the - which-key information will be overwritten. To restore the old default simply - #+BEGIN_SRC emacs-lisp - (setq which-key-show-prefix 'echo) - #+END_SRC - The function =which-key-show-top-level= was implemented by @iqbalansari (thanks!) to show top-level key bindings (those not behind a prefix). You can use =M-x which-key-show-top-level= to try it and bind it to a key if you like. diff --git a/which-key.el b/which-key.el index 016536fefb3..5e68f5c4cda 100644 --- a/which-key.el +++ b/which-key.el @@ -164,7 +164,7 @@ and nil. Nil turns the feature off." :group 'which-key :type 'integer) -(defcustom which-key-side-window-location 'bottom +(defcustom which-key-side-window-location 'echo "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 @@ -565,7 +565,7 @@ bottom." (interactive) (setq which-key-popup-type 'side-window which-key-side-window-location 'bottom - which-key-show-prefix 'bottom)) + which-key-show-prefix 'echo)) ;;;###autoload (defun which-key-setup-minibuffer () commit 841f461b22848d1b7167803c9b1e345055b1adf8 Author: Justin Burkett Date: Wed Nov 18 20:57:51 2015 -0500 Automatically close popup when prefix goes away It was necessary to hit C-g twice to close the popup before this change. diff --git a/which-key.el b/which-key.el index 34483c46ab7..016536fefb3 100644 --- a/which-key.el +++ b/which-key.el @@ -388,6 +388,7 @@ showing.") "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-key-based-description-replacement-alist '() "New version of @@ -780,6 +781,7 @@ total height." "This function is called to hide the which-key buffer." (unless (eq real-this-command 'which-key-show-next-page) (setq which-key--current-page-n nil + which-key--using-top-level nil which-key--on-last-page nil) (cl-case which-key-popup-type ;; Not necessary to hide minibuffer @@ -1597,6 +1599,7 @@ Will force an update if called before `which-key--update'." (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)) (defun which-key-undo () @@ -1657,20 +1660,22 @@ Finally, show the buffer." ;; (message "key: %s" (key-description prefix-keys))) ;; (when (> (length prefix-keys) 0) ;; (message "key binding: %s" (key-binding prefix-keys))) - (when (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) - ;; 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)) - (null this-command))) - (which-key--create-buffer-and-show prefix-keys)))) + (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) + ;; 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)) + (null this-command))) + (which-key--create-buffer-and-show prefix-keys)) + ((and which-key--current-page-n (not which-key--using-top-level)) + (which-key--hide-popup))))) ;; Timers commit 279b318cc698ab89d3db19231865590bb548f350 Author: Justin Burkett Date: Wed Nov 18 20:24:23 2015 -0500 Provide alternative for prefix-title If echo-keystrokes is non nil, we're showing in the bottom window, and the prefix is shown in the top or bottom line, there's not much reason to show the prefix again since it's so close to the echo area. diff --git a/which-key.el b/which-key.el index 46934790fef..34483c46ab7 100644 --- a/which-key.el +++ b/which-key.el @@ -1123,9 +1123,12 @@ An empty stiring is returned if no title exists." (mode-res (when mode-alist (assoc key-lst mode-alist)))) (cond (mode-res (cdr mode-res)) (res (cdr res)) - ((and (eq which-key-show-prefix 'bottom) + ((and (member which-key-show-prefix '(bottom top)) + (eq which-key-side-window-location 'bottom) echo-keystrokes) - (concat (key-description key-lst) "-")) + (if (symbolp (key-binding (apply #'vector key-lst))) + (symbol-name (key-binding (apply #'vector key-lst))) + (concat "Following " (key-description key-lst)))) (t ""))) "Top-level bindings")) @@ -1377,7 +1380,7 @@ Returns a plist that holds the page strings, as well as metadata." (push page-width page-widths)) (list :pages (nreverse pages) :page-height avl-lines :page-widths (nreverse page-widths) - :keys/page (nreverse keys/page) :n-pages n-pages + :keys/page (reverse keys/page) :n-pages n-pages :tot-keys (apply #'+ keys/page))))) (defun which-key--create-pages (keys sel-win-width) @@ -1482,8 +1485,8 @@ enough space based on your settings and frame size." prefix-keys) (prefix-w-face (if (eq which-key-show-prefix 'echo) prefix-keys (which-key--propertize-key prefix-keys))) (dash-w-face (if which-key--current-prefix - (if (eq which-key-show-prefix 'echo) "-" - (propertize "-" 'face 'which-key-key-face)) + (if (eq which-key-show-prefix 'echo) "-" + (propertize "-" 'face 'which-key-key-face)) "")) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) @@ -1518,13 +1521,20 @@ enough space based on your settings and frame size." prefix-keys) new-end (concat "\n" (make-string first-col-width 32)) page (concat first (mapconcat #'identity (cdr lines) new-end))))) ((eq which-key-show-prefix 'top) - (setq page (concat prefix-w-face dash-w-face " " - status-top " " nxt-pg-hint "\n" page))) + (setq page + (concat + (when (or (null echo-keystrokes) + (not (eq which-key-side-window-location 'bottom))) + (concat prefix-w-face dash-w-face " ")) + status-top " " nxt-pg-hint "\n" page))) ((eq which-key-show-prefix 'bottom) - (setq page (concat page "\n" - (when (null echo-keystrokes) - (concat prefix-w-face dash-w-face " ")) - status-top " " nxt-pg-hint))) + (setq page + (concat + page "\n" + (when (or (null echo-keystrokes) + (not (eq which-key-side-window-location 'bottom))) + (concat prefix-w-face dash-w-face " ")) + status-top " " nxt-pg-hint))) ((eq which-key-show-prefix 'echo) (which-key--echo (concat prefix-w-face dash-w-face (when prefix-keys " ") commit 24839e665d974d93c4ed038538c5887dc3d54dbd Author: Justin Burkett Date: Wed Nov 18 14:58:35 2015 -0500 Fix spacing in last commit diff --git a/README.org b/README.org index 59a5af46f94..bf56704cdfc 100644 --- a/README.org +++ b/README.org @@ -9,11 +9,9 @@ The echo area is not a good default, because it's not possible to completely control what shows there without doing something ugly, so occasionally the which-key information will be overwritten. To restore the old default simply - #+BEGIN_SRC emacs-lisp (setq which-key-show-prefix 'echo) #+END_SRC - - The function =which-key-show-top-level= was implemented by @iqbalansari (thanks!) to show top-level key bindings (those not behind a prefix). You can use =M-x which-key-show-top-level= to try it and bind it to a key if you like. commit 8f9bd782f7fa48095cad283e00e7d7cf8680e42a Author: Justin Burkett Date: Wed Nov 18 14:57:01 2015 -0500 Mention new show-prefix option and format README diff --git a/README.org b/README.org index 542a91218d5..59a5af46f94 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,19 @@ * 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]] ** What's New +- Implemented =bottom= as an option for =which-key-show-prefix=, which will show + the key, page number, and next page key information on the last line of the + which-key buffer. +- This is the new default for =which-key-setup-side-window-bottom=. The old + default, which is still available, used the echo area for this information. + The echo area is not a good default, because it's not possible to completely + control what shows there without doing something ugly, so occasionally the + which-key information will be overwritten. To restore the old default simply + + #+BEGIN_SRC emacs-lisp + (setq which-key-show-prefix 'echo) + #+END_SRC + - The function =which-key-show-top-level= was implemented by @iqbalansari (thanks!) to show top-level key bindings (those not behind a prefix). You can use =M-x which-key-show-top-level= to try it and bind it to a key if you like. @@ -72,7 +85,7 @@ minor mode of course. *** Manually Add which-key.el to your =load-path= and require. Something like -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp (add-to-list 'load-path "path/to/which-key.el") (require 'which-key) (which-key-mode) @@ -109,7 +122,7 @@ This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacEma *** Side Window Bottom Option Popup side window on bottom. This is the current default. To restore this setup use -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp (which-key-setup-side-window-bottom) #+END_SRC @@ -118,7 +131,7 @@ Popup side window on bottom. This is the current default. To restore this setup *** Side Window Right Option Popup side window on right. For defaults use -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp (which-key-setup-side-window-right) #+END_SRC @@ -136,14 +149,14 @@ 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 +#+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 +#+BEGIN_SRC emacs-lisp (which-key-setup-minibuffer) #+END_SRC @@ -167,16 +180,16 @@ 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 +#+BEGIN_SRC emacs-lisp (setq which-key-popup-type 'minibuffer) #+END_SRC Show keys in the minibuffer. **** side window -#+BEGIN_SRC Emacs-lisp +#+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 +#+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 @@ -195,13 +208,13 @@ Show keys in a side window. This popup type has further options: #+END_SRC **** frame -#+BEGIN_SRC Emacs-lisp +#+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 +#+BEGIN_SRC emacs-lisp ;; max width of which-key frame: number of columns (an integer) (setq which-key-frame-max-width 60) @@ -218,7 +231,7 @@ variables for more information, but here is a working example (this is the current implementation of side-window bottom). -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp (setq which-key-popup-type 'custom) (defun which-key-custom-popup-max-dimensions-function (ignore) (cons @@ -253,7 +266,7 @@ variable directly.] Using this method, the description of a key is replaced using a string that you provide. Here's an example -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp (which-key-add-key-based-replacements "C-x C-f" "find files") #+END_SRC @@ -263,7 +276,7 @@ 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 +#+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") @@ -280,7 +293,7 @@ descriptions directly. The relevant variables are =which-key-key-replacement-alist= and =which-key-description-replacement-alist=. Here's an example of one of the default key replacements -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp ("<\\([[:alnum:]-]+\\)>" . "\\1") #+END_SRC @@ -288,7 +301,7 @@ The =car= takes a string which may use Emacs regexp and the =cdr= takes a string with the replacement text. As shown, you can specify a sub-expression of the match. The replacements do not need to use regexp and can be as simple as -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp ("left" . "lft") #+END_SRC @@ -297,7 +310,7 @@ 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 +#+BEGIN_SRC emacs-lisp (add-to-list 'which-key-key-replacement-alist '("TAB" . "↹")) (add-to-list 'which-key-key-replacement-alist '("RET" . "⏎")) (add-to-list 'which-key-key-replacement-alist '("DEL" . "⇤")) @@ -314,7 +327,7 @@ their order are You can control the order by setting this variable. This also shows the other available options. -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp ;; default (setq which-key-sort-order 'which-key-key-order) ;; same as default, except single characters are sorted alphabetically @@ -335,7 +348,7 @@ 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 +#+BEGIN_SRC emacs-lisp (setq which-key-use-C-h-for-paging nil) #+END_SRC to disable the behavior (this will only take effect after toggling @@ -358,7 +371,7 @@ The default configuration below will allow you to switch paging using =C-h= until you reach the last page of keys in the which-key buffer. The next press of =C-h= will close the which-key buffer and trigger the default Emacs behavior on =C-h=. -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp (setq which-key-use-C-h-for-paging t which-key-prevent-C-h-from-cycling t) #+END_SRC @@ -372,13 +385,13 @@ Note =C-h= is by default equivalent to =?= in this context. Essentially, all you need to do for a prefix like =C-x= is the following which will bind == to the relevant command. -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp (define-key which-key-mode-map (kbd "C-x ") 'which-key-show-next-page) #+END_SRC This is completely equivalent to -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp (setq which-key-paging-prefixes '("C-x")) (setq which-key-paging-key "") #+END_SRC @@ -404,13 +417,13 @@ 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 +#+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 +#+BEGIN_SRC emacs-lisp (set-face-attribute 'which-key-local-map-description-face nil :weight 'bold) #+END_SRC @@ -421,9 +434,9 @@ your liking. The options below are also available through customize. Their defaults are shown. -#+BEGIN_SRC Emacs-lisp +#+BEGIN_SRC emacs-lisp ;; Set the time delay (in seconds) for the which-key popup to appear. - (setq which-key-idle-delay 1.0) + (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. @@ -446,9 +459,9 @@ shown. ;; the feature (setq which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL")) - ;; Show the key prefix on the left or top (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. + ;; 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. commit cf8052d6caf9f09615452c822990c2a8031e6562 Author: Justin Burkett Date: Wed Nov 18 13:36:51 2015 -0500 Add show-prfx 'bottom and change top-level msg 'bottom is a "safer" default because it's impossible to control the echo area completely, so the message gets wiped out occasionally. Use prefix-titles for the top-level bindings message, since top-level is not really a key diff --git a/which-key.el b/which-key.el index 7dea2c32139..46934790fef 100644 --- a/which-key.el +++ b/which-key.el @@ -139,14 +139,15 @@ and have `which-key-special-key-face' applied to them." :group 'which-key :type 'string) -(defcustom which-key-show-prefix 'echo +(defcustom which-key-show-prefix 'bottom "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 keys" left) - (const :tag "In first line" top) - (const :tag "In echo area" echo) + :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 "Hide" nil))) (defcustom which-key-popup-type 'side-window @@ -561,10 +562,9 @@ if there is space and the bottom otherwise." "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)) + which-key-show-prefix 'bottom)) ;;;###autoload (defun which-key-setup-minibuffer () @@ -1116,13 +1116,18 @@ occurs return the new STRING." "KEY-LST is a list of keys produced by `listify-key-sequences'. A title is possibly returned using `which-key-prefix-title-alist'. An empty stiring is returned if no title exists." - (let* ((alist which-key-prefix-title-alist) - (res (assoc key-lst alist)) - (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc key-lst mode-alist)))) - (cond (mode-res (cdr mode-res)) - (res (cdr res)) - (t "")))) + (if key-lst + (let* ((alist which-key-prefix-title-alist) + (res (assoc key-lst alist)) + (mode-alist (assq major-mode alist)) + (mode-res (when mode-alist (assoc key-lst mode-alist)))) + (cond (mode-res (cdr mode-res)) + (res (cdr res)) + ((and (eq which-key-show-prefix 'bottom) + echo-keystrokes) + (concat (key-description key-lst) "-")) + (t ""))) + "Top-level bindings")) (defun which-key--maybe-replace-key-based (string key-lst) "KEY-LST is a list of keys produced by `listify-key-sequences' @@ -1387,8 +1392,8 @@ is the width of the live window." (prefix-w-face (which-key--propertize-key prefix-keys-desc)) (prefix-left (when (eq which-key-show-prefix 'left) (+ 2 (string-width prefix-w-face)))) - (prefix-top (eq which-key-show-prefix 'top)) - (avl-lines (if prefix-top (- max-lines 1) max-lines)) + (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-left (- max-width prefix-left) max-width)) (vertical (and (eq which-key-popup-type 'side-window) @@ -1430,11 +1435,6 @@ area." delay nil (lambda () (let (message-log-max) (message "%s" text)))))) -(defun which-key--prefix-keys-description (prefix-keys) - (if prefix-keys - (key-description prefix-keys) - "Top-level bindings")) - (defun which-key--next-page-hint (prefix-keys page-n n-pages) "Return string for next page hint." (let* ((paging-key (concat prefix-keys " " which-key-paging-key)) @@ -1466,7 +1466,7 @@ area." "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 (which-key--prefix-keys-description which-key--current-prefix)) + (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 \ @@ -1520,9 +1520,16 @@ enough space based on your settings and frame size." prefix-keys) ((eq which-key-show-prefix 'top) (setq page (concat prefix-w-face dash-w-face " " status-top " " nxt-pg-hint "\n" page))) + ((eq which-key-show-prefix 'bottom) + (setq page (concat page "\n" + (when (null echo-keystrokes) + (concat prefix-w-face dash-w-face " ")) + status-top " " nxt-pg-hint))) ((eq which-key-show-prefix 'echo) - (which-key--echo (concat prefix-w-face dash-w-face " " - status-top " " nxt-pg-hint)))) + (which-key--echo (concat prefix-w-face dash-w-face + (when prefix-keys " ") + status-top (when status-top " ") + nxt-pg-hint)))) (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) (which-key--echo page) @@ -1622,7 +1629,7 @@ Finally, show the buffer." (setq which-key--current-prefix prefix-keys which-key--last-try-2-loc nil) (let ((formatted-keys (which-key--get-formatted-key-bindings)) - (prefix-keys (which-key--prefix-keys-description which-key--current-prefix))) + (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) commit 6cb95565d65db56ef6292b41415951e72922e532 Author: Justin Burkett Date: Wed Nov 18 10:49:23 2015 -0500 Ignore key translations only at top-level C-x 8 is a valid place to put translations for example diff --git a/which-key.el b/which-key.el index 75bd580d87d..7dea2c32139 100644 --- a/which-key.el +++ b/which-key.el @@ -1232,7 +1232,8 @@ alists. Returns a list (key separator description)." (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 "mouse-\\|wheel-\\|remap\\|drag-\\|scroll-bar\\|select-window\\|switch-frame")) + (ignore-keys-regexp "mouse-\\|wheel-\\|remap\\|drag-\\|scroll-bar\\|select-window\\|switch-frame") + (ignore-sections-regexp "\\(Key translations\\|Function key map translations\\|Input decoding map translations\\)")) (with-temp-buffer (let ((indent-tabs-mode t)) (describe-buffer-bindings buffer which-key--current-prefix)) @@ -1254,7 +1255,8 @@ alists. Returns a list (key separator description)." ((looking-at "^[ \t]*$") ;; ignore ) - ((not (string-match-p "translations:" header)) + ((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)))) commit fe5be11e6ec06be7b2c83cc4b262b41153426524 Author: Justin Burkett Date: Wed Nov 18 10:21:49 2015 -0500 Option to remove default unicode characters diff --git a/which-key.el b/which-key.el index 7c57ccfdea1..75bd580d87d 100644 --- a/which-key.el +++ b/which-key.el @@ -74,11 +74,6 @@ each key column." :group 'which-key :type 'integer) -(defcustom which-key-separator " → " - "Separator to use between key and description." - :group 'which-key - :type 'string) - (defcustom which-key-unicode-correction 3 "Correction for wide unicode characters. Since we measure width in terms of the number of characters, @@ -95,8 +90,21 @@ 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." + :group 'which-key + :type 'string) + (defcustom which-key-key-replacement-alist - '(("<\\([[:alnum:]-]+\\)>" . "\\1") ("left" . "←") ("right" . "→")) + (if which-key-dont-use-unicode + '(("<\\([[:alnum:]-]+\\)>" . "\\1")) + '(("<\\([[:alnum:]-]+\\)>" . "\\1") ("left" . "←") ("right" . "→"))) "The strings in the car of each cons are replaced with the strings in the cdr for each key. Elisp regexp can be used as in the first example." @@ -479,6 +487,18 @@ it's set too high)." ;; previous 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))) + ;; (defun which-key--setup-undo-key () ;; "Bind `which-key-undo-key' in `which-key-undo-keymaps'." ;; (when (and which-key-undo-key which-key-undo-keymaps) commit d694bbe4c1e84ebe492c75727ba731fd238d2560 Merge: ef44d0771ab 3af2f25803d Author: Justin Burkett Date: Wed Nov 18 05:26:06 2015 -0500 Merge pull request #86 from syohex/byte-compile-warnings Fix byte compile warnings commit 3af2f25803dbd578e1c6264ba47212a94018757b Author: Syohei YOSHIDA Date: Wed Nov 18 12:55:56 2015 +0900 Use bound-and-true-p for byte compile warning diff --git a/which-key.el b/which-key.el index 919fe5478d8..7c57ccfdea1 100644 --- a/which-key.el +++ b/which-key.el @@ -1426,8 +1426,7 @@ area." (and (< 1 n-pages) paging-key-bound) use-descbind) (not (and which-key-allow-evil-operators - (boundp 'evil-this-operator) - evil-this-operator))) + (bound-and-true-p evil-this-operator)))) (propertize (format "[%s %s]" key (if use-descbind "help" next-page-n)) 'face 'which-key-note-face)))) @@ -1630,7 +1629,7 @@ Finally, show the buffer." (not which-key-inhibit) ;; Do not display the popup if a command is currently being ;; executed - (or (and which-key-allow-evil-operators evil-this-operator) + (or (and which-key-allow-evil-operators (bound-and-true-p evil-this-operator)) (null this-command))) (which-key--create-buffer-and-show prefix-keys)))) commit e888ee885a9923af34ad1126fc13eb00e4e39f92 Author: Syohei YOSHIDA Date: Wed Nov 18 12:54:31 2015 +0900 Move definition position for byte-compile warning diff --git a/which-key.el b/which-key.el index 257d9511eb6..919fe5478d8 100644 --- a/which-key.el +++ b/which-key.el @@ -1032,6 +1032,10 @@ special (SPC,TAB,...) < single char < mod (C-,M-,...) < other." 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 @@ -1140,10 +1144,6 @@ If KEY contains any \"special keys\" defined in (concat (substring desc 0 which-key-max-description-length) "..") desc)) -(defsubst which-key--group-p (description) - (or (string-match-p "^\\(group:\\|Prefix\\)" description) - (keymapp (intern description)))) - (defun which-key--highlight-face (description) "Return the highlight face for DESCRIPTION if it has one." (let (face) commit ef44d0771abcc433bed6c164a62d2e5abbe5957f Author: Justin Burkett Date: Tue Nov 17 21:50:55 2015 -0500 Sort character ranges properly Fix #85 diff --git a/which-key.el b/which-key.el index af8e88edd69..257d9511eb6 100644 --- a/which-key.el +++ b/which-key.el @@ -974,36 +974,40 @@ width) in lines and characters respectively." (defun which-key--key-description< (a b &optional alpha) "Sorting function used for `which-key-key-order' and `which-key-key-order-alpha'." - (let* ((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 "" a)) - (bfn? (string-match-p "" 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) - (string-lessp a b))) - ((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 "" "\\1" a)) - (string-to-number (replace-regexp-in-string "" "\\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) - (string-lessp a b))) - ((or apr? bpr?) apr?) - (t (string-lessp a b))))) + (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 "" a)) + (bfn? (string-match-p "" 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) + (string-lessp a b))) + ((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 "" "\\1" a)) + (string-to-number (replace-regexp-in-string "" "\\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) + (string-lessp a b))) + ((or apr? bpr?) apr?) + (t (string-lessp a b)))))) (defsubst which-key-key-order-alpha (acons bcons) "Order key descriptions A and B. commit aa60a2364e9c1ae511b7f43714c5996a6673e456 Author: Justin Burkett Date: Mon Nov 16 22:31:10 2015 -0500 Make special-key matching case sensitive diff --git a/which-key.el b/which-key.el index 175832175f6..af8e88edd69 100644 --- a/which-key.el +++ b/which-key.el @@ -1117,7 +1117,8 @@ If KEY contains any \"special keys\" defined in (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)) commit 25bd62aa49117eb9c99b751a569399f404ee3d15 Author: Justin Burkett Date: Mon Nov 16 22:13:16 2015 -0500 Refactor sorting functions and move fn keys up diff --git a/which-key.el b/which-key.el index 6f131f08985..175832175f6 100644 --- a/which-key.el +++ b/which-key.el @@ -962,15 +962,18 @@ width) in lines and characters respectively." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Sorting functions -(defun which-key--alpha< (a b) - (let ((da (downcase a)) - (db (downcase b))) - (if (string-equal da db) - (not (string-lessp a b)) - (string-lessp da db)))) - -(defun which-key--key-description-alpha< (a b) - "Sorting function used for `which-key-key-order-alpha'." +(defun which-key--string< (a b &optional alpha) + (if alpha + (let ((da (downcase a)) + (db (downcase b))) + (if (string-equal da db) + (not (string-lessp a b)) + (string-lessp da db))) + (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'." (let* ((aem? (string-equal a "")) (bem? (string-equal b "")) (a1? (= 1 (length a))) @@ -986,17 +989,18 @@ width) in lines and characters respectively." (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-alpha< (substring a 3) (substring b 3)) + (which-key--key-description< (substring a 3) (substring b 3) alpha) (string-lessp a b))) ((or asp? bsp?) asp?) - ((and a1? b1?) (which-key--alpha< a b)) + ((and a1? b1?) (which-key--string< a b alpha)) ((or a1? b1?) a1?) ((and afn? bfn?) (< (string-to-number (replace-regexp-in-string "" "\\1" a)) (string-to-number (replace-regexp-in-string "" "\\1" b)))) + ((or afn? bfn?) afn?) ((and apr? bpr?) (if (string-equal (substring a 0 2) (substring b 0 2)) - (which-key--key-description-alpha< (substring a 2) (substring b 2)) + (which-key--key-description< (substring a 2) (substring b 2) alpha) (string-lessp a b))) ((or apr? bpr?) apr?) (t (string-lessp a b))))) @@ -1009,39 +1013,7 @@ 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-alpha< (car acons) (car bcons))) - -(defun which-key--key-description< (a b) - "Sorting function used for `which-key-key-order'." - (let* ((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 "" a)) - (bfn? (string-match-p "" 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)) - (string-lessp a b))) - ((or asp? bsp?) asp?) - ((and a1? b1?) (string-lessp a b)) - ((or a1? b1?) a1?) - ((and afn? bfn?) - (< (string-to-number (replace-regexp-in-string "" "\\1" a)) - (string-to-number (replace-regexp-in-string "" "\\1" b)))) - ((and apr? bpr?) - (if (string-equal (substring a 0 2) (substring b 0 2)) - (which-key--key-description< (substring a 2) (substring b 2)) - (string-lessp a b))) - ((or apr? bpr?) apr?) - (t (string-lessp a b))))) + (which-key--key-description< (car acons) (car bcons) t)) (defsubst which-key-key-order (acons bcons) "Order key descriptions A and B. commit 0bddd2db10e03f531e4bc4be2edb36e00b05e9df Author: Justin Burkett Date: Mon Nov 16 22:02:18 2015 -0500 Silence warnings for obsolete function diff --git a/which-key.el b/which-key.el index 1243bc02806..6f131f08985 100644 --- a/which-key.el +++ b/which-key.el @@ -1536,7 +1536,8 @@ enough space based on your settings and frame size." prefix-keys) ;; used for paging at top-level (if (fboundp 'set-transient-map) (set-transient-map (which-key--get-popup-map)) - (set-temporary-overlay-map (which-key--get-popup-map))))) + (with-no-warnings + (set-temporary-overlay-map (which-key--get-popup-map)))))) (defun which-key-show-next-page () "Show the next page of keys. commit 39fb658dbf57c5063ded560332d19d45a34078ad Author: Justin Burkett Date: Mon Nov 16 21:57:59 2015 -0500 Turn on case-sensitivity in replacements Should avoid situations like #84 diff --git a/which-key.el b/which-key.el index 93cda2c8e25..1243bc02806 100644 --- a/which-key.el +++ b/which-key.el @@ -1080,7 +1080,8 @@ to replace and the cdr is the replacement text. Unless LITERAL is non-nil regexp is used in the replacements. Whether or not a replacement occurs return the new STRING." (save-match-data - (let ((new-string string)) + (let ((new-string string) + case-fold-search) (dolist (repl repl-alist) (when (string-match (car repl) new-string) (setq new-string commit b0991a8a91d0d2d606fc5fa05a84db1c6d1ce774 Author: Justin Burkett Date: Mon Nov 16 20:13:58 2015 -0500 Satisfy compiler diff --git a/which-key.el b/which-key.el index 721fe561451..93cda2c8e25 100644 --- a/which-key.el +++ b/which-key.el @@ -1240,7 +1240,7 @@ alists. Returns a list (key separator description)." (describe-buffer-bindings buffer which-key--current-prefix)) (goto-char (point-min)) (let ((header-p (not (= (char-after) ?\f))) - sections header section) + bindings header) (while (not (eobp)) (cond (header-p @@ -1250,8 +1250,8 @@ alists. Returns a list (key separator description)." (setq header-p nil) (forward-line 3)) ((= (char-after) ?\f) - ;; (push (cons header (nreverse section)) sections) - (setq section nil) + ;; (push (cons header (nreverse section)) bindings) + ;; (setq section nil) (setq header-p t)) ((looking-at "^[ \t]*$") ;; ignore @@ -1275,20 +1275,18 @@ alists. Returns a list (key separator description)." ((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) sections) - (push (cons (match-string 1 key) binding) sections))) + (unless (assoc-string (match-string 1 key) bindings) + (push (cons (match-string 1 key) binding) bindings))) ((string-match "^\\([^ \t]+\\|[^ \t]+ \\.\\. [^ \t]+\\)[ \t]+$" key) - (unless (assoc-string (match-string 1 key) sections) - (push (cons (match-string 1 key) binding) sections))))))))) + (unless (assoc-string (match-string 1 key) bindings) + (push (cons (match-string 1 key) binding) bindings))))))))) (forward-line)) - (nreverse sections))))) + (nreverse bindings))))) (defun which-key--get-formatted-key-bindings () "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." - (let* ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) - (buffer (current-buffer)) - (unformatted (which-key--get-current-bindings))) + (let* ((unformatted (which-key--get-current-bindings))) (when which-key-sort-order (setq unformatted (sort unformatted (lambda (a b) (funcall which-key-sort-order a b))))) commit 7068ebd224509f02c6a857f5df5ac72070c1ff76 Author: Justin Burkett Date: Mon Nov 16 16:17:10 2015 -0500 Bring in new describe-buffer-bindings parsing func based on similar function in helm-descbinds. This parses the output of describe-buffer-bindings line by line, and is easier to follow and manipulate than the previous one that uses complicated regexp expressions. diff --git a/which-key.el b/which-key.el index ce38096f3cd..721fe561451 100644 --- a/which-key.el +++ b/which-key.el @@ -1229,57 +1229,66 @@ alists. Returns a list (key separator description)." (list key-w-face sep-w-face desc-w-face))) unformatted))) +;; adapted from helm-descbinds +(defun which-key--get-current-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 "mouse-\\|wheel-\\|remap\\|drag-\\|scroll-bar\\|select-window\\|switch-frame")) + (with-temp-buffer + (let ((indent-tabs-mode t)) + (describe-buffer-bindings buffer which-key--current-prefix)) + (goto-char (point-min)) + (let ((header-p (not (= (char-after) ?\f))) + sections header section) + (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) + ;; (push (cons header (nreverse section)) sections) + (setq section nil) + (setq header-p t)) + ((looking-at "^[ \t]*$") + ;; ignore + ) + ((not (string-match-p "translations:" header)) + (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) + ;; key (replace-regexp-in-string"^[ \t\n]+" "" key) + ;; key (replace-regexp-in-string"[ \t\n]+$" "" key) + ) + (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) sections) + (push (cons (match-string 1 key) binding) sections))) + ((string-match "^\\([^ \t]+\\|[^ \t]+ \\.\\. [^ \t]+\\)[ \t]+$" key) + (unless (assoc-string (match-string 1 key) sections) + (push (cons (match-string 1 key) binding) sections))))))))) + (forward-line)) + (nreverse sections))))) + (defun which-key--get-formatted-key-bindings () "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." (let* ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) (buffer (current-buffer)) - ;; Temporarily use tabs to indent - (indent-tabs-mode t) - (keybinding-regex - (if which-key--current-prefix - (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" - key-str-qt) - ;; For toplevel binding, we search for lines which - ;; start with a sequence of characters other than - ;; space and tab and '<', '>' except function keys - ;; (these are ignored since mostly these - ;; are the keyboard input definitions provided by - ;; iso-transl or (mouse) bindings for the `fringe' - ;; or `modeline' which might not be as interesting) - ;; the initial sequence should be followed by one - ;; or more tab/space which are then followed by a - ;; sequence of non newline/tab characters. - ;; Additionally keybindings of the form [a-z] - ;; .. [a-z] are also matched - ;; For example the following should match - ;; C-x Prefix Command - ;; Some command - ;; a .. z Some command - ;; But following should not - ;; C-x 8 Prefix Command - ;; Prefix Command - "^\\([^ <>\t]+\\|\\|\\w \\.\\. \\w\\)[ \t]+\\([^\t\n]+\\)$")) - (lines-to-flush '("[bB]inding[s]?[:]?$" - "translations:$" - "-------$" - "self-insert-command$")) - key-match desc-match unformatted) - (save-match-data - (with-temp-buffer - (describe-buffer-bindings buffer which-key--current-prefix) - (when which-key-hide-alt-key-translations - (goto-char (point-min)) - (flush-lines "^A-")) - (goto-char (point-min)) - (dolist (line-to-flush lines-to-flush) - (save-excursion (flush-lines line-to-flush))) - (goto-char (point-max)) ; want to put last keys in first - (while (re-search-backward keybinding-regex nil t) - (setq key-match (match-string 1) - desc-match (match-string 2)) - (cl-pushnew (cons key-match desc-match) unformatted - :test (lambda (x y) (string-equal (car x) (car y))))))) + (unformatted (which-key--get-current-bindings))) (when which-key-sort-order (setq unformatted (sort unformatted (lambda (a b) (funcall which-key-sort-order a b))))) commit b0f9f580f3a04f4fe75754f1f2a32d2cf3532d9b Author: Justin Burkett Date: Sun Nov 15 21:39:33 2015 -0500 Mention show-top-level in the README diff --git a/README.org b/README.org index 4a7a4e3daac..542a91218d5 100644 --- a/README.org +++ b/README.org @@ -1,5 +1,11 @@ * 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]] +** What's New +- The function =which-key-show-top-level= was implemented by @iqbalansari + (thanks!) to show top-level key bindings (those not behind a prefix). You can + use =M-x which-key-show-top-level= to try it and bind it to a key if you like. + It should function just like any other which-key popup once it's called. + ** 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 @@ -25,6 +31,7 @@ Many of these have been implemented and are described below. ** Table of Contents :TOC@4: - [[#which-key-][which-key ]] + - [[#whats-new][What's New]] - [[#introduction][Introduction]] - [[#install][Install]] - [[#melpa][MELPA]] @@ -35,6 +42,7 @@ Many of these have been implemented and are described below. - [[#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]] - [[#minibuffer][minibuffer]] @@ -144,6 +152,13 @@ Take over the minibuffer. For the recommended configuration use 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=. @@ -454,4 +469,8 @@ It requires testing on different platforms with different configurations, which is beyond my capabilities. The default configuration has been reasonably stable for me. ** Thanks -Thanks to @bmag for helping with the initial development and finding many bugs. +Special thanks to +- @bmag for helping with the initial development and finding many + bugs. +- @iqbalansari who among other things adapted the code to make + =which-key-show-top-level= possible. commit b2c7d25dde96ca13e4d0d1f92191ca5cf962c3f5 Author: Justin Burkett Date: Fri Nov 13 13:05:28 2015 -0500 Minor stylistic changes to previous pr diff --git a/which-key.el b/which-key.el index 41d6875a885..ce38096f3cd 100644 --- a/which-key.el +++ b/which-key.el @@ -261,7 +261,7 @@ prefixes in `which-key-paging-prefixes'" :type 'boolean) (defcustom which-key-hide-alt-key-translations t - "Should key translations using Alt key be hidden. + "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. @@ -554,11 +554,6 @@ bottom." (setq which-key-popup-type 'minibuffer which-key-show-prefix 'left)) -;;;###autoload -(defun which-key-toplevel () - (interactive) - (which-key--create-buffer-and-show nil)) - ;; Helper functions to modify replacement lists. (defun which-key--add-key-val-to-alist (alist key value &optional alist-name) @@ -1241,30 +1236,34 @@ BUFFER that follow the key sequence KEY-SEQ." (buffer (current-buffer)) ;; Temporarily use tabs to indent (indent-tabs-mode t) - (keybinding-regex (if which-key--current-prefix - (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" - key-str-qt) - ;; For toplevel binding, we search for lines which - ;; start with a sequence of characters other than - ;; space and tab and '<', '>' except function keys - ;; (these are ignored since mostly these - ;; are the keyboard input definitions provided by - ;; iso-transl or (mouse) bindings for the `fringe' - ;; or `modeline' which might not be as interesting) - ;; the initial sequence should be followed by one - ;; or more tab/space which are then followed by a - ;; sequence of non newline/tab characters. - ;; Additionally keybindings of the form [a-z] - ;; .. [a-z] are also matched - ;; For example the following should match - ;; C-x Prefix Command - ;; Some command - ;; a .. z Some command - ;; But following should not - ;; C-x 8 Prefix Command - ;; Prefix Command - "^\\([^ <>\t]+\\|\\|\\w \\.\\. \\w\\)[ \t]+\\([^\t\n]+\\)$")) - (lines-to-flush'("[bB]inding[s]?[:]?$" "translations:$" "-------$" "self-insert-command$")) + (keybinding-regex + (if which-key--current-prefix + (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" + key-str-qt) + ;; For toplevel binding, we search for lines which + ;; start with a sequence of characters other than + ;; space and tab and '<', '>' except function keys + ;; (these are ignored since mostly these + ;; are the keyboard input definitions provided by + ;; iso-transl or (mouse) bindings for the `fringe' + ;; or `modeline' which might not be as interesting) + ;; the initial sequence should be followed by one + ;; or more tab/space which are then followed by a + ;; sequence of non newline/tab characters. + ;; Additionally keybindings of the form [a-z] + ;; .. [a-z] are also matched + ;; For example the following should match + ;; C-x Prefix Command + ;; Some command + ;; a .. z Some command + ;; But following should not + ;; C-x 8 Prefix Command + ;; Prefix Command + "^\\([^ <>\t]+\\|\\|\\w \\.\\. \\w\\)[ \t]+\\([^\t\n]+\\)$")) + (lines-to-flush '("[bB]inding[s]?[:]?$" + "translations:$" + "-------$" + "self-insert-command$")) key-match desc-match unformatted) (save-match-data (with-temp-buffer @@ -1427,7 +1426,7 @@ area." (defun which-key--prefix-keys-description (prefix-keys) (if prefix-keys (key-description prefix-keys) - "Toplevel ")) + "Top-level bindings")) (defun which-key--next-page-hint (prefix-keys page-n n-pages) "Return string for next page hint." @@ -1476,8 +1475,10 @@ enough space based on your settings and frame size." prefix-keys) (n-tot (plist-get which-key--pages-plist :tot-keys)) (prefix-w-face (if (eq which-key-show-prefix 'echo) prefix-keys (which-key--propertize-key prefix-keys))) - (dash-w-face (if (eq which-key-show-prefix 'echo) "-" - (propertize "-" 'face 'which-key-key-face))) + (dash-w-face (if which-key--current-prefix + (if (eq which-key-show-prefix 'echo) "-" + (propertize "-" 'face 'which-key-key-face)) + "")) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) (status-top (propertize (which-key--maybe-get-prefix-title @@ -1524,10 +1525,10 @@ enough space based on your settings and frame size." prefix-keys) (insert page) (goto-char (point-min))) (which-key--show-popup (cons height width))))) - - ;; TODO: Replace this with `set-transient-map' when we drop support for - ;; Emacs v24.3 - (set-temporary-overlay-map (which-key--get-popup-map)))) + ;; used for paging at top-level + (if (fboundp 'set-transient-map) + (set-transient-map (which-key--get-popup-map)) + (set-temporary-overlay-map (which-key--get-popup-map))))) (defun which-key-show-next-page () "Show the next page of keys. @@ -1568,6 +1569,12 @@ Will force an update if called before `which-key--update'." (which-key--show-page next-page)) (which-key--start-paging-timer))))) +;;;###autoload +(defun which-key-show-top-level () + "Show top-level bindings." + (interactive) + (which-key--create-buffer-and-show nil)) + (defun which-key-undo () "Undo last keypress and force which-key update." (interactive) commit d3fe7b2e2aefcb09a22985d01f1e7b8cb5461b42 Author: Iqbal Ansari Date: Fri Nov 13 21:38:16 2015 +0530 Ignore self-insert-command bindings diff --git a/which-key.el b/which-key.el index fea86ab304a..41d6875a885 100644 --- a/which-key.el +++ b/which-key.el @@ -1264,7 +1264,7 @@ BUFFER that follow the key sequence KEY-SEQ." ;; C-x 8 Prefix Command ;; Prefix Command "^\\([^ <>\t]+\\|\\|\\w \\.\\. \\w\\)[ \t]+\\([^\t\n]+\\)$")) - (lines-to-flush'("[bB]inding[s]?[:]?$" "translations:$" "-------$")) + (lines-to-flush'("[bB]inding[s]?[:]?$" "translations:$" "-------$" "self-insert-command$")) key-match desc-match unformatted) (save-match-data (with-temp-buffer commit 25d006eac1d10ab81a3c197875e1b3cf286918bb Author: Iqbal Ansari Date: Fri Nov 13 08:53:24 2015 +0530 Include keybindings of the form 'a .. z' in which key popup diff --git a/which-key.el b/which-key.el index ed156794468..fea86ab304a 100644 --- a/which-key.el +++ b/which-key.el @@ -1253,14 +1253,17 @@ BUFFER that follow the key sequence KEY-SEQ." ;; or `modeline' which might not be as interesting) ;; the initial sequence should be followed by one ;; or more tab/space which are then followed by a - ;; sequence of non newline/tab characters + ;; sequence of non newline/tab characters. + ;; Additionally keybindings of the form [a-z] + ;; .. [a-z] are also matched ;; For example the following should match ;; C-x Prefix Command ;; Some command + ;; a .. z Some command ;; But following should not ;; C-x 8 Prefix Command ;; Prefix Command - "^\\([^ <>\t]+\\|\\)[ \t]+\\([^\t\n]+\\)$")) + "^\\([^ <>\t]+\\|\\|\\w \\.\\. \\w\\)[ \t]+\\([^\t\n]+\\)$")) (lines-to-flush'("[bB]inding[s]?[:]?$" "translations:$" "-------$")) key-match desc-match unformatted) (save-match-data commit 6aec4bd9f4bbad6ebdd703f916bd73851274ae3e Author: Iqbal Ansari Date: Fri Nov 13 08:21:47 2015 +0530 Use `set-temporary-overlay-map` to setup paging keys for toplevel popup diff --git a/which-key.el b/which-key.el index 7e07631e7b4..ed156794468 100644 --- a/which-key.el +++ b/which-key.el @@ -401,7 +401,6 @@ key sequence. prefix-title is a string. The title is displayed alongside the actual current key sequence when `which-key-show-prefix' is set to either top or echo.") - ;;;###autoload (define-minor-mode which-key-mode "Toggle which-key-mode." @@ -1446,6 +1445,15 @@ area." (if use-descbind "help" next-page-n)) 'face 'which-key-note-face)))) +(defun which-key--get-popup-map () + (unless which-key--current-prefix + (let ((map (make-sparse-keymap))) + (define-key map (kbd which-key-paging-key) #'which-key-show-next-page) + (when which-key-use-C-h-for-paging + ;; Show next page even when C-h is pressed + (define-key map (kbd "C-h") #'which-key-show-next-page)) + map))) + (defun which-key--show-page (n) "Show page N, starting from 0." (which-key--init-buffer) ;; in case it was killed @@ -1512,7 +1520,11 @@ enough space based on your settings and frame size." prefix-keys) (erase-buffer) (insert page) (goto-char (point-min))) - (which-key--show-popup (cons height width))))))) + (which-key--show-popup (cons height width))))) + + ;; TODO: Replace this with `set-transient-map' when we drop support for + ;; Emacs v24.3 + (set-temporary-overlay-map (which-key--get-popup-map)))) (defun which-key-show-next-page () "Show the next page of keys. commit 26ca465bd168555b450c707159a5a29addb03bf6 Author: Iqbal Ansari Date: Sat Oct 10 18:38:08 2015 +0530 Manually flush headings for keybindings diff --git a/which-key.el b/which-key.el index 14fc5b050d4..7e07631e7b4 100644 --- a/which-key.el +++ b/which-key.el @@ -1262,6 +1262,7 @@ BUFFER that follow the key sequence KEY-SEQ." ;; C-x 8 Prefix Command ;; Prefix Command "^\\([^ <>\t]+\\|\\)[ \t]+\\([^\t\n]+\\)$")) + (lines-to-flush'("[bB]inding[s]?[:]?$" "translations:$" "-------$")) key-match desc-match unformatted) (save-match-data (with-temp-buffer @@ -1269,6 +1270,9 @@ BUFFER that follow the key sequence KEY-SEQ." (when which-key-hide-alt-key-translations (goto-char (point-min)) (flush-lines "^A-")) + (goto-char (point-min)) + (dolist (line-to-flush lines-to-flush) + (save-excursion (flush-lines line-to-flush))) (goto-char (point-max)) ; want to put last keys in first (while (re-search-backward keybinding-regex nil t) (setq key-match (match-string 1) commit cdd2934d0dc9d90b897d7a7028501ef2e918df41 Author: Iqbal Ansari Date: Sat Oct 10 18:37:04 2015 +0530 Allow function key bindings to be displayed in toplevel help diff --git a/which-key.el b/which-key.el index a66d4fcac96..14fc5b050d4 100644 --- a/which-key.el +++ b/which-key.el @@ -1247,20 +1247,21 @@ BUFFER that follow the key sequence KEY-SEQ." key-str-qt) ;; For toplevel binding, we search for lines which ;; start with a sequence of characters other than - ;; space and tab and '<', '>' (these are ignored - ;; since mostly these are the keyboard input - ;; definitions provided by iso-transl or (mouse) - ;; bindings for the `fringe' or `modeline' which - ;; might not be as interesting), the initial - ;; sequence should be followed by one or more - ;; tab/space which are then followed by a sequence - ;; of non newline/tab characters + ;; space and tab and '<', '>' except function keys + ;; (these are ignored since mostly these + ;; are the keyboard input definitions provided by + ;; iso-transl or (mouse) bindings for the `fringe' + ;; or `modeline' which might not be as interesting) + ;; the initial sequence should be followed by one + ;; or more tab/space which are then followed by a + ;; sequence of non newline/tab characters ;; For example the following should match ;; C-x Prefix Command + ;; Some command ;; But following should not ;; C-x 8 Prefix Command ;; Prefix Command - "^\\([^ <>\t]+\\)[ \t]+\\([^\t\n]+\\)$")) + "^\\([^ <>\t]+\\|\\)[ \t]+\\([^\t\n]+\\)$")) key-match desc-match unformatted) (save-match-data (with-temp-buffer commit 95788e94c14af6fd95cd00c84f217947484c3f4b Author: Iqbal Ansari Date: Sat Oct 10 18:05:09 2015 +0530 Add a command to popup toplevel bindings diff --git a/which-key.el b/which-key.el index a7222ea0a6a..a66d4fcac96 100644 --- a/which-key.el +++ b/which-key.el @@ -555,6 +555,11 @@ bottom." (setq which-key-popup-type 'minibuffer which-key-show-prefix 'left)) +;;;###autoload +(defun which-key-toplevel () + (interactive) + (which-key--create-buffer-and-show nil)) + ;; Helper functions to modify replacement lists. (defun which-key--add-key-val-to-alist (alist key value &optional alist-name) commit 09aff8b342f3b9a1b39e9f2b7712ec3c44e17c89 Author: Iqbal Ansari Date: Sat Oct 10 18:05:00 2015 +0530 Fix some minor bugs diff --git a/which-key.el b/which-key.el index d14e13dba04..a7222ea0a6a 100644 --- a/which-key.el +++ b/which-key.el @@ -1159,7 +1159,7 @@ If KEY contains any \"special keys\" defined in (defsubst which-key--truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." (if (and which-key-max-description-length - (> (string-width desc) which-key-max-description-length)) + (> (length desc) which-key-max-description-length)) (concat (substring desc 0 which-key-max-description-length) "..") desc)) @@ -1585,7 +1585,7 @@ Finally, show the buffer." (let ((formatted-keys (which-key--get-formatted-key-bindings)) (prefix-keys (which-key--prefix-keys-description which-key--current-prefix))) (cond ((= (length formatted-keys) 0) - (message "%s- which-key: There are no keys to show" prefix-keys-desc)) + (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 commit 652af436e84c1dcb9746d574c0408570cdc64a24 Author: Iqbal Ansari Date: Sat Oct 10 18:04:02 2015 +0530 Improve regexp to match toplevel bindings diff --git a/which-key.el b/which-key.el index 23a51a5d94a..d14e13dba04 100644 --- a/which-key.el +++ b/which-key.el @@ -1235,11 +1235,27 @@ alists. Returns a list (key separator description)." BUFFER that follow the key sequence KEY-SEQ." (let* ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) (buffer (current-buffer)) + ;; Temporarily use tabs to indent (indent-tabs-mode t) (keybinding-regex (if which-key--current-prefix (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt) - "^\\([^ <>\t]+\\)[\t]+\\([^\n]+\\)$")) + ;; For toplevel binding, we search for lines which + ;; start with a sequence of characters other than + ;; space and tab and '<', '>' (these are ignored + ;; since mostly these are the keyboard input + ;; definitions provided by iso-transl or (mouse) + ;; bindings for the `fringe' or `modeline' which + ;; might not be as interesting), the initial + ;; sequence should be followed by one or more + ;; tab/space which are then followed by a sequence + ;; of non newline/tab characters + ;; For example the following should match + ;; C-x Prefix Command + ;; But following should not + ;; C-x 8 Prefix Command + ;; Prefix Command + "^\\([^ <>\t]+\\)[ \t]+\\([^\t\n]+\\)$")) key-match desc-match unformatted) (save-match-data (with-temp-buffer commit bbe4817313434e36621152c5160ce39571acf725 Author: Iqbal Ansari Date: Thu Oct 8 08:41:52 2015 +0530 Change code to handle nil which-key--current-prefix This would happen when viewing toplevel bindings diff --git a/which-key.el b/which-key.el index caf1744c8b9..23a51a5d94a 100644 --- a/which-key.el +++ b/which-key.el @@ -260,6 +260,15 @@ prefixes in `which-key-paging-prefixes'" :group 'which-key :type 'boolean) +(defcustom which-key-hide-alt-key-translations t + "Should key translations using Alt key be hidden. +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) + ;; Faces (defgroup which-key-faces nil "Faces for which-key-mode" @@ -1224,17 +1233,22 @@ alists. Returns a list (key separator description)." (defun which-key--get-formatted-key-bindings () "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." - (let ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) - (buffer (current-buffer)) - key-match desc-match unformatted) + (let* ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) + (buffer (current-buffer)) + (indent-tabs-mode t) + (keybinding-regex (if which-key--current-prefix + (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" + key-str-qt) + "^\\([^ <>\t]+\\)[\t]+\\([^\n]+\\)$")) + key-match desc-match unformatted) (save-match-data (with-temp-buffer (describe-buffer-bindings buffer which-key--current-prefix) + (when which-key-hide-alt-key-translations + (goto-char (point-min)) + (flush-lines "^A-")) (goto-char (point-max)) ; want to put last keys in first - (while (re-search-backward - (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" - key-str-qt) - nil t) + (while (re-search-backward keybinding-regex nil t) (setq key-match (match-string 1) desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted @@ -1382,6 +1396,11 @@ area." delay nil (lambda () (let (message-log-max) (message "%s" text)))))) +(defun which-key--prefix-keys-description (prefix-keys) + (if prefix-keys + (key-description prefix-keys) + "Toplevel ")) + (defun which-key--next-page-hint (prefix-keys page-n n-pages) "Return string for next page hint." (let* ((paging-key (concat prefix-keys " " which-key-paging-key)) @@ -1405,7 +1424,7 @@ area." "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)) + (prefix-keys (which-key--prefix-keys-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 \ @@ -1542,14 +1561,13 @@ Will force an update if called before `which-key--update'." (which-key--show-page page-n) loc2)))) - -(defun which-key--create-buffer-and-show (prefix-keys) +(defun which-key--create-buffer-and-show (&optional prefix-keys) "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 ((formatted-keys (which-key--get-formatted-key-bindings)) - (prefix-keys-desc (key-description prefix-keys))) + (prefix-keys (which-key--prefix-keys-description which-key--current-prefix))) (cond ((= (length formatted-keys) 0) (message "%s- which-key: There are no keys to show" prefix-keys-desc)) ((listp which-key-side-window-location) commit 65f0755dd8a2a5bb560c86b09d1c45b3006b2fdc Author: Justin Burkett Date: Fri Nov 13 12:03:26 2015 -0500 Fix sort order of function keys diff --git a/which-key.el b/which-key.el index 7025fc5dc46..caf1744c8b9 100644 --- a/which-key.el +++ b/which-key.el @@ -972,18 +972,23 @@ width) in lines and characters respectively." (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))) + (bpr? (string-match-p prrgxp b)) + (afn? (string-match-p "" a)) + (bfn? (string-match-p "" 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)) + (which-key--key-description-alpha< (substring a 3) (substring b 3)) (string-lessp a b))) ((or asp? bsp?) asp?) ((and a1? b1?) (which-key--alpha< a b)) ((or a1? b1?) a1?) + ((and afn? bfn?) + (< (string-to-number (replace-regexp-in-string "" "\\1" a)) + (string-to-number (replace-regexp-in-string "" "\\1" b)))) ((and apr? bpr?) (if (string-equal (substring a 0 2) (substring b 0 2)) - (which-key--key-description< (substring a 2) (substring b 2)) + (which-key--key-description-alpha< (substring a 2) (substring b 2)) (string-lessp a b))) ((or apr? bpr?) apr?) (t (string-lessp a b))))) @@ -1009,7 +1014,9 @@ before upper." (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))) + (bpr? (string-match-p prrgxp b)) + (afn? (string-match-p "" a)) + (bfn? (string-match-p "" b))) (cond ((or aem? bem?) (and aem? (not bem?))) ((and asp? bsp?) (if (string-equal (substring a 0 3) (substring b 0 3)) @@ -1018,6 +1025,9 @@ before upper." ((or asp? bsp?) asp?) ((and a1? b1?) (string-lessp a b)) ((or a1? b1?) a1?) + ((and afn? bfn?) + (< (string-to-number (replace-regexp-in-string "" "\\1" a)) + (string-to-number (replace-regexp-in-string "" "\\1" b)))) ((and apr? bpr?) (if (string-equal (substring a 0 2) (substring b 0 2)) (which-key--key-description< (substring a 2) (substring b 2)) commit fd8681828e30f49d1f2e73ef919a7caa3be32bc8 Author: Justin Burkett Date: Fri Nov 13 08:55:20 2015 -0500 Don't use face for prefix if using echo area With some themes the switch from the text from echo-keystrokes with no face to the which-key text with a face is annoying. diff --git a/which-key.el b/which-key.el index f4786e6706e..7025fc5dc46 100644 --- a/which-key.el +++ b/which-key.el @@ -1408,8 +1408,10 @@ enough space based on your settings and frame size." prefix-keys) (width (nth page-n (plist-get which-key--pages-plist :page-widths))) (n-shown (nth page-n (plist-get which-key--pages-plist :keys/page))) (n-tot (plist-get which-key--pages-plist :tot-keys)) - (prefix-w-face (which-key--propertize-key prefix-keys)) - (dash-w-face (propertize "-" 'face 'which-key-key-face)) + (prefix-w-face (if (eq which-key-show-prefix 'echo) prefix-keys + (which-key--propertize-key prefix-keys))) + (dash-w-face (if (eq which-key-show-prefix 'echo) "-" + (propertize "-" 'face 'which-key-key-face))) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) (status-top (propertize (which-key--maybe-get-prefix-title commit b0a13d88dffe9a729d79b7098ee670a505711d73 Author: Justin Burkett Date: Thu Nov 12 13:29:42 2015 -0500 Bump minor version diff --git a/which-key.el b/which-key.el index d875ffff2ea..f4786e6706e 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.7 +;; Version: 0.7.1 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 51044ea80b6623f513fb3772ffdb4fed44f76636 Author: Justin Burkett Date: Thu Nov 12 13:23:59 2015 -0500 Add option to pad key columns on the left Allows you to make more space between the columns if you think the layout is too tight. diff --git a/README.org b/README.org index 8e56c9dbcf6..4a7a4e3daac 100644 --- a/README.org +++ b/README.org @@ -411,9 +411,13 @@ shown. (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 + ;; 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) + ;; 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 diff --git a/which-key.el b/which-key.el index f24f0d156dc..d875ffff2ea 100644 --- a/which-key.el +++ b/which-key.el @@ -68,6 +68,12 @@ 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-separator " → " "Separator to use between key and description." :group 'which-key @@ -1258,7 +1264,8 @@ element in each list element of 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--max-len col-keys 0)) + (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))) commit e447eaf944f41fa00e83ce079a6793e6644116a7 Author: Justin Burkett Date: Tue Nov 3 20:26:48 2015 -0500 Fix #79 Explicitly set word-wrap in which-key buffer. Fix unicode correction diff --git a/which-key.el b/which-key.el index fa240388ef5..f24f0d156dc 100644 --- a/which-key.el +++ b/which-key.el @@ -435,7 +435,8 @@ alongside the actual current key sequence when (message "")) (setq-local cursor-type nil) (setq-local cursor-in-non-selected-windows nil) - (setq-local mode-line-format nil)))) + (setq-local mode-line-format nil) + (setq-local word-wrap nil)))) (defun which-key--setup () "Initial setup for which-key. @@ -918,7 +919,7 @@ Measured in lines and characters respectively." max-mini-window-height)) max-mini-window-height) ;; width - (frame-text-cols))) + (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 . @@ -932,10 +933,12 @@ width) in lines and characters respectively." ;; 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 - (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)) - (frame-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)) + (frame-width)) + which-key-unicode-correction)))) (defun which-key--frame-max-dimensions () "Return max-dimensions of the frame popup (height . commit 864218b307e0017acebfbc71ecea7d5e2391a0c6 Author: Justin Burkett Date: Tue Nov 3 20:03:29 2015 -0500 Add example of adding Unicode replacements in README Thanks @epitzer for the suggestion. https://github.com/justbur/emacs-which-key/issues/52 diff --git a/README.org b/README.org index a9a70d8c3f2..8e56c9dbcf6 100644 --- a/README.org +++ b/README.org @@ -277,11 +277,16 @@ match. The replacements do not need to use regexp and can be as simple as ("left" . "lft") #+END_SRC -You can add this element to the key list with (there are no helper functions for -these alists) +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-key-replacement-alist '("left" . "lft")) +(add-to-list 'which-key-key-replacement-alist '("TAB" . "↹")) +(add-to-list 'which-key-key-replacement-alist '("RET" . "⏎")) +(add-to-list 'which-key-key-replacement-alist '("DEL" . "⇤")) +(add-to-list 'which-key-key-replacement-alist '("SPC" . "␣")) #+END_SRC *** Sorting Options commit d777bb50fdb3a80ce7c1d35d36590a75199adef8 Author: Justin Burkett Date: Thu Oct 29 21:06:48 2015 -0400 Don't show help hint for evil operators Paging and help doesn't work for these, so don't offer diff --git a/which-key.el b/which-key.el index ddced1974f8..fa240388ef5 100644 --- a/which-key.el +++ b/which-key.el @@ -1371,9 +1371,12 @@ area." (next-page-n (format "pg %s" (1+ (mod (1+ page-n) n-pages)))) (use-descbind (and which-key--on-last-page which-key-use-C-h-for-paging which-key-prevent-C-h-from-cycling))) - (when (or (and (< 1 n-pages) which-key-use-C-h-for-paging) - (and (< 1 n-pages) paging-key-bound) - use-descbind) + (when (and (or (and (< 1 n-pages) which-key-use-C-h-for-paging) + (and (< 1 n-pages) paging-key-bound) + use-descbind) + (not (and which-key-allow-evil-operators + (boundp 'evil-this-operator) + evil-this-operator))) (propertize (format "[%s %s]" key (if use-descbind "help" next-page-n)) 'face 'which-key-note-face)))) commit 8740f0f4e6651eebb06c56a37c90e0fbc087070c Author: Justin Burkett Date: Thu Oct 29 20:51:09 2015 -0400 Add option to show popup for evil operators Default is to enable if evil is loaded before which-key. Otherwise, it is disabled. diff --git a/which-key.el b/which-key.el index 74cd627f4a1..ddced1974f8 100644 --- a/which-key.el +++ b/which-key.el @@ -247,6 +247,13 @@ prefixes in `which-key-paging-prefixes'" :group 'which-key :type 'boolean) +(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) + ;; Faces (defgroup which-key-faces nil "Faces for which-key-mode" @@ -1546,7 +1553,8 @@ Finally, show the buffer." (not which-key-inhibit) ;; Do not display the popup if a command is currently being ;; executed - (null this-command)) + (or (and which-key-allow-evil-operators evil-this-operator) + (null this-command))) (which-key--create-buffer-and-show prefix-keys)))) ;; Timers commit 8b4b1ee05685a58fb8edad76517937ada0864594 Author: Justin Burkett Date: Wed Oct 28 22:52:28 2015 -0400 Add melpa stable banner diff --git a/README.org b/README.org index 10df9b07c75..a9a70d8c3f2 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,5 @@ * which-key -[[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]] - +[[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]] ** 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 diff --git a/which-key.el b/which-key.el index 2e2c03b010c..74cd627f4a1 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.6.2 +;; Version: 0.7 ;; Keywords: ;; Package-Requires: ((emacs "24.3")) commit 777c28444a2497733a2fb62308fa5e2ef434f427 Author: Justin Burkett Date: Thu Oct 22 09:59:36 2015 -0400 Don't warn when same cons is added to alist twice diff --git a/which-key.el b/which-key.el index 81f6b272f7a..2e2c03b010c 100644 --- a/which-key.el +++ b/which-key.el @@ -542,9 +542,10 @@ bottom." (let ((key-lst (listify-key-sequence (kbd key)))) (cond ((null alist) (list (cons key-lst value))) ((assoc key-lst alist) - (message "which-key: changing %s name from %s to %s in the %s alist" - key (cdr (assoc key-lst alist)) value alist-name) - (setcdr (assoc key-lst alist) value) + (when (not (string-equal (cdr (assoc key-lst alist)) value)) + (message "which-key: changing %s name from %s to %s in the %s alist" + key (cdr (assoc key-lst alist)) value alist-name) + (setcdr (assoc key-lst alist) value)) alist) (t (cons (cons key-lst value) alist))))) commit 7226967e4ffbc0c9ed185ce922c0de86de9c5ab5 Author: Justin Burkett Date: Tue Oct 20 09:26:07 2015 -0400 Move sorting functions and add to readme diff --git a/README.org b/README.org index 2e3231f1cff..10df9b07c75 100644 --- a/README.org +++ b/README.org @@ -290,19 +290,22 @@ 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 (a, ...) < Modifier (C-, M-, ...) < Other= +=Special (SPC, TAB, ...) < Single Character (ASCII) (a, ...) < Modifier (C-, M-, ...) < Other= -You can control the order by setting this variable. +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) -;; or (setq which-key-sort-order 'which-key-description-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) +;; sort based on the key description ignoring case +;; (setq which-key-sort-order 'which-key-description-order) #+END_SRC -The only other built-in option at the moment (besides using nil to turn off -sorting completely) is =which-key-description-order=, which orders by the key's -description based on the usual ordering of strings after applying =downcase=. - *** 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 diff --git a/which-key.el b/which-key.el index 45d509929b4..81f6b272f7a 100644 --- a/which-key.el +++ b/which-key.el @@ -934,6 +934,103 @@ width) in lines and characters respectively." width) in lines and characters respectively." (cons which-key-frame-max-height which-key-frame-max-width)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Sorting functions + +(defun which-key--alpha< (a b) + (let ((da (downcase a)) + (db (downcase b))) + (if (string-equal da db) + (not (string-lessp a b)) + (string-lessp da db)))) + +(defun which-key--key-description-alpha< (a b) + "Sorting function used for `which-key-key-order-alpha'." + (let* ((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))) + (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)) + (string-lessp a b))) + ((or asp? bsp?) asp?) + ((and a1? b1?) (which-key--alpha< a b)) + ((or a1? b1?) a1?) + ((and apr? bpr?) + (if (string-equal (substring a 0 2) (substring b 0 2)) + (which-key--key-description< (substring a 2) (substring b 2)) + (string-lessp a b))) + ((or apr? bpr?) apr?) + (t (string-lessp a b))))) + +(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-alpha< (car acons) (car bcons))) + +(defun which-key--key-description< (a b) + "Sorting function used for `which-key-key-order'." + (let* ((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))) + (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)) + (string-lessp a b))) + ((or asp? bsp?) asp?) + ((and a1? b1?) (string-lessp a b)) + ((or a1? b1?) a1?) + ((and apr? bpr?) + (if (string-equal (substring a 0 2) (substring b 0 2)) + (which-key--key-description< (substring a 2) (substring b 2)) + (string-lessp a b))) + ((or apr? bpr?) apr?) + (t (string-lessp a b))))) + +(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)))) + +(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)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for retrieving and formatting keys @@ -1097,100 +1194,6 @@ alists. Returns a list (key separator description)." (list key-w-face sep-w-face desc-w-face))) unformatted))) -(defun which-key--alpha< (a b) - (let ((da (downcase a)) - (db (downcase b))) - (if (string-equal da db) - (not (string-lessp a b)) - (string-lessp da db)))) - -(defun which-key--key-description-alpha< (a b) - "Sorting function used for `which-key-key-order-alpha'." - (let* ((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))) - (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)) - (string-lessp a b))) - ((or asp? bsp?) asp?) - ((and a1? b1?) (which-key--alpha< a b)) - ((or a1? b1?) a1?) - ((and apr? bpr?) - (if (string-equal (substring a 0 2) (substring b 0 2)) - (which-key--key-description< (substring a 2) (substring b 2)) - (string-lessp a b))) - ((or apr? bpr?) apr?) - (t (string-lessp a b))))) - -(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-alpha< (car acons) (car bcons))) - -(defun which-key--key-description< (a b) - "Sorting function used for `which-key-key-order'." - (let* ((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))) - (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)) - (string-lessp a b))) - ((or asp? bsp?) asp?) - ((and a1? b1?) (string-lessp a b)) - ((or a1? b1?) a1?) - ((and apr? bpr?) - (if (string-equal (substring a 0 2) (substring b 0 2)) - (which-key--key-description< (substring a 2) (substring b 2)) - (string-lessp a b))) - ((or apr? bpr?) apr?) - (t (string-lessp a b))))) - -(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)))) - -(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--get-formatted-key-bindings () "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." commit 3cdf8a476c911b704d3d1724ea8dacbc1dbfc098 Author: Justin Burkett Date: Sun Oct 18 19:48:04 2015 -0400 Better choices for built-in functions Thanks @xuchunyang! diff --git a/which-key.el b/which-key.el index d6c198b2947..45d509929b4 100644 --- a/which-key.el +++ b/which-key.el @@ -1217,12 +1217,6 @@ BUFFER that follow the key sequence KEY-SEQ." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for laying out which-key buffer pages -(defun which-key--n-empty-strings (n) - "Produce a list of N empty strings." - (let (res) - (dotimes (_i n res) - (setq res (cons "" res))))) - (defun which-key--pad (columns) "Pad COLUMNS to the same length using empty strings." (let ((max-len (cl-reduce (lambda (a x) (max a (length x))) columns @@ -1230,13 +1224,13 @@ BUFFER that follow the key sequence KEY-SEQ." (mapcar (lambda (c) (if (< (length c) max-len) - (append c (which-key--n-empty-strings (- max-len (length c)))) + (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--pad (reverse columns))) + (let* ((padded (which-key--pad (nreverse columns))) (rows (apply #'cl-mapcar #'list padded))) (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n"))) @@ -1262,12 +1256,12 @@ that width." col-keys)))) (defun which-key--partition-list (n list) - "Partition LIST into N-sized sublists" + "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))) - (reverse res))) + (nreverse res))) (defun which-key--partition-columns (keys avl-lines avl-width) "Convert list of KEYS to columns based on dimensions AVL-LINES and AVL-WIDTH. @@ -1297,9 +1291,9 @@ Returns a plist that holds the page strings, as well as metadata." (push (which-key--join-columns page-cols) pages) (push n-keys keys/page) (push page-width page-widths)) - (list :pages (reverse pages) :page-height avl-lines - :page-widths (reverse page-widths) - :keys/page (reverse keys/page) :n-pages n-pages + (list :pages (nreverse pages) :page-height avl-lines + :page-widths (nreverse page-widths) + :keys/page (nreverse keys/page) :n-pages n-pages :tot-keys (apply #'+ keys/page))))) (defun which-key--create-pages (keys sel-win-width) commit 8e0e11347914ade692516ef9bc3d9b9de6ceb99e Author: Justin Burkett Date: Sun Oct 18 14:15:48 2015 -0400 Cleanup previous commit diff --git a/which-key.el b/which-key.el index 0397722bc45..d6c198b2947 100644 --- a/which-key.el +++ b/which-key.el @@ -1220,9 +1220,8 @@ BUFFER that follow the key sequence KEY-SEQ." (defun which-key--n-empty-strings (n) "Produce a list of N empty strings." (let (res) - (dotimes (_i n) - (setq res (cons "" res))) - res)) + (dotimes (_i n res) + (setq res (cons "" res))))) (defun which-key--pad (columns) "Pad COLUMNS to the same length using empty strings." commit 61be00149a25d6ef5f81ea5724426ac50b5f0e6e Author: Justin Burkett Date: Sun Oct 18 13:31:11 2015 -0400 Remove dash.el dependency diff --git a/which-key.el b/which-key.el index 58caeb64c7a..0397722bc45 100644 --- a/which-key.el +++ b/which-key.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/justbur/emacs-which-key ;; Version: 0.6.2 ;; Keywords: -;; Package-Requires: ((emacs "24.3") (dash "2.11.0")) +;; Package-Requires: ((emacs "24.3")) ;; 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 @@ -39,7 +39,6 @@ ;;; Code: (require 'cl-lib) -(require 'dash) (eval-when-compile (defvar golden-ratio-mode)) @@ -1218,9 +1217,27 @@ BUFFER that follow the key sequence KEY-SEQ." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for laying out which-key buffer pages +(defun which-key--n-empty-strings (n) + "Produce a list of N empty strings." + (let (res) + (dotimes (_i n) + (setq res (cons "" res))) + res)) + +(defun which-key--pad (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 (which-key--n-empty-strings (- 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 (apply (apply-partially #'-pad "") (reverse columns))) + (let* ((padded (which-key--pad (reverse columns))) (rows (apply #'cl-mapcar #'list padded))) (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n"))) @@ -1245,11 +1262,19 @@ that width." (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))) + (reverse res))) + (defun which-key--partition-columns (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 - (-partition-all avl-lines keys))) + (which-key--partition-list avl-lines keys))) (page-width 0) (n-pages 0) (n-keys 0) page-cols pages page-widths keys/page col) (if (> (apply #'max (mapcar #'car cols-w-widths)) avl-width) commit d63ce4f19698b57191a220b09672cc2a81ec640b Author: Justin Burkett Date: Sun Oct 18 12:31:40 2015 -0400 Remove s.el dependency diff --git a/which-key.el b/which-key.el index 7008f1bb64b..58caeb64c7a 100644 --- a/which-key.el +++ b/which-key.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/justbur/emacs-which-key ;; Version: 0.6.2 ;; Keywords: -;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) +;; Package-Requires: ((emacs "24.3") (dash "2.11.0")) ;; 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 @@ -39,7 +39,6 @@ ;;; Code: (require 'cl-lib) -(require 's) (require 'dash) (eval-when-compile @@ -1241,10 +1240,9 @@ that width." (col-width (+ 1 col-key-width col-sep-width col-desc-width))) (cons col-width (mapcar (lambda (k) - (concat - (s-repeat (- col-key-width (string-width (nth 0 k))) " ") - (nth 0 k) (nth 1 k) (nth 2 k) - (s-repeat (- col-desc-width (string-width (nth 2 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-columns (keys avl-lines avl-width) @@ -1382,22 +1380,25 @@ enough space based on your settings and frame size." prefix-keys) 'face 'which-key-note-face)))) (first-col-width (+ 2 (max (string-width prefix-w-face) (string-width status-left)))) - (prefix-left (s-pad-right first-col-width " " prefix-w-face)) - (status-left (s-pad-right first-col-width " " status-left)) + (prefix-left (format (concat "%-" (int-to-string first-col-width) "s") + prefix-w-face)) + (status-left (format (concat "%-" (int-to-string first-col-width) "s") + status-left)) (nxt-pg-hint (which-key--next-page-hint prefix-keys page-n n-pages)) new-end lines first) (cond ((and (< 1 n-pages) (eq which-key-show-prefix 'left)) (setq lines (split-string page "\n") first (concat prefix-left (car lines) "\n" status-left) - new-end (concat "\n" (s-repeat first-col-width " ")) + new-end (concat "\n" (make-string first-col-width 32)) page (concat first (mapconcat #'identity (cdr lines) new-end)))) ((eq which-key-show-prefix 'left) (if (= 1 height) (setq page (concat prefix-left page)) (setq lines (split-string page "\n") - first (concat prefix-left (car lines) "\n" (s-repeat first-col-width " ")) - new-end (concat "\n" (s-repeat first-col-width " ")) + first (concat prefix-left (car lines) + "\n" (make-string first-col-width 32)) + new-end (concat "\n" (make-string first-col-width 32)) page (concat first (mapconcat #'identity (cdr lines) new-end))))) ((eq which-key-show-prefix 'top) (setq page (concat prefix-w-face dash-w-face " " commit 2ea4c91d97d90dbc918e9a123b80e7a4376ee0b7 Author: Justin Burkett Date: Thu Oct 15 10:52:48 2015 -0400 Satisfy compiler for golden-ratio-mode diff --git a/which-key.el b/which-key.el index 49731d71d0f..7008f1bb64b 100644 --- a/which-key.el +++ b/which-key.el @@ -42,6 +42,9 @@ (require 's) (require 'dash) +(eval-when-compile + (defvar golden-ratio-mode)) + (defgroup which-key nil "Customization options for which-key-mode" :group 'help @@ -659,7 +662,7 @@ addition KEY-SEQUENCE NAME pairs) to apply." RECURSING is for internal use." (when recursing (define-key map key def)) (map-keymap - (lambda (ev df) + (lambda (_ev df) (when (keymapp df) (which-key-define-key-recursively df key def t))) map)) @@ -1484,6 +1487,7 @@ Will force an update if called before `which-key--update'." (which-key--show-page page-n) loc2)))) + (defun which-key--create-buffer-and-show (prefix-keys) "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." commit 8f23bd79c6bf44245925dddacb56a4f485117928 Author: Justin Burkett Date: Thu Oct 8 21:59:40 2015 -0400 Preliminary support for undo diff --git a/which-key.el b/which-key.el index 621586ae867..49731d71d0f 100644 --- a/which-key.el +++ b/which-key.el @@ -219,6 +219,17 @@ 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-for-paging t "Use C-h for paging if non-nil. Normally C-h after a prefix calls `describe-prefix-bindings'. This changes that command to @@ -426,6 +437,7 @@ set too high) and setup which-key buffer." (eq which-key-popup-type 'minibuffer)) (which-key--setup-echo-keystrokes)) (which-key--check-key-based-alist) + ;; (which-key--setup-undo-key) (which-key--init-buffer) (setq which-key--is-setup t)) @@ -444,6 +456,13 @@ it's set too high)." ;; previous echo-keystrokes) ))) +;; (defun which-key--setup-undo-key () +;; "Bind `which-key-undo-key' in `which-key-undo-keymaps'." +;; (when (and which-key-undo-key which-key-undo-keymaps) +;; (dolist (map which-key-undo-keymaps) +;; (which-key-define-key-recursively +;; map (kbd which-key-undo-key) 'which-key-undo)))) + (defun which-key--check-key-based-alist () "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'" (let ((alist which-key-key-based-description-replacement-alist) @@ -635,6 +654,16 @@ addition KEY-SEQUENCE NAME pairs) to apply." (push (cons mode mode-name-alist) which-key-prefix-name-alist)))) (put 'which-key-declare-prefixes-for-mode 'lisp-indent-function 'defun) +(defun which-key-define-key-recursively (map key def &optional recursing) + "Recursively bind KEY in MAP to DEF on every level of MAP except the first. +RECURSING is for internal use." + (when recursing (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 @@ -1421,6 +1450,17 @@ Will force an update if called before `which-key--update'." (which-key--show-page next-page)) (which-key--start-paging-timer))))) +(defun which-key-undo () + "Undo last keypress and force which-key update." + (interactive) + (let* ((key-str (this-command-keys)) + (key-str (substring key-str 0 (- (length key-str) 2))) + (ev (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence key-str)))) + (which-key--stop-timer) + (setq unread-command-events ev) + (which-key--create-buffer-and-show key-str) + (which-key--start-timer))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update commit f91ebdad78d91b04318ce4a8f6661a8f118c1ff0 Author: Justin Burkett Date: Thu Oct 8 08:16:26 2015 -0400 Add new sort function for testing This is a variation on key order, which uses alphabetical sorting for characters, putting lowercase before uppercase. @syl20bnr diff --git a/which-key.el b/which-key.el index 274bea5f562..621586ae867 100644 --- a/which-key.el +++ b/which-key.el @@ -1067,6 +1067,50 @@ alists. Returns a list (key separator description)." (list key-w-face sep-w-face desc-w-face))) unformatted))) +(defun which-key--alpha< (a b) + (let ((da (downcase a)) + (db (downcase b))) + (if (string-equal da db) + (not (string-lessp a b)) + (string-lessp da db)))) + +(defun which-key--key-description-alpha< (a b) + "Sorting function used for `which-key-key-order-alpha'." + (let* ((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))) + (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)) + (string-lessp a b))) + ((or asp? bsp?) asp?) + ((and a1? b1?) (which-key--alpha< a b)) + ((or a1? b1?) a1?) + ((and apr? bpr?) + (if (string-equal (substring a 0 2) (substring b 0 2)) + (which-key--key-description< (substring a 2) (substring b 2)) + (string-lessp a b))) + ((or apr? bpr?) apr?) + (t (string-lessp a b))))) + +(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-alpha< (car acons) (car bcons))) + (defun which-key--key-description< (a b) "Sorting function used for `which-key-key-order'." (let* ((aem? (string-equal a "")) commit ac33130bc8dac37bacec2a5a6e8f47256b780240 Author: Justin Burkett Date: Wed Oct 7 09:01:28 2015 -0400 Fix problem with two locations for side-window Can't always reuse the same window in this case when we go to a deeper set of keybindings, because we may need to switch sides. diff --git a/which-key.el b/which-key.el index 76c14442879..274bea5f562 100644 --- a/which-key.el +++ b/which-key.el @@ -344,6 +344,7 @@ showing.") (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-key-based-description-replacement-alist '() "New version of @@ -774,9 +775,15 @@ call signature in different emacs versions" ;; +------------+------------+ +------------+------------+ ;; (display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist)) ;; side defaults to bottom - (if (get-buffer-window which-key--buffer) - (display-buffer-reuse-window which-key--buffer alist) - (display-buffer-in-major-side-window which-key--buffer side 0 alist)))) + (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-major-side-window which-key--buffer side 0 alist)) + ((get-buffer-window which-key--buffer) + (display-buffer-reuse-window which-key--buffer alist)) + (t + (display-buffer-in-major-side-window which-key--buffer side 0 alist))))) (defun which-key--show-buffer-frame (act-popup-dim) "Show which-key buffer when popup type is frame." @@ -1364,7 +1371,8 @@ Will force an update if called before `which-key--update'." (which-key--stop-timer) (setq unread-command-events next-event) (if which-key--last-try-2-loc - (let ((which-key-side-window-location 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))))) @@ -1375,15 +1383,18 @@ Will force an update if called before `which-key--update'." (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)) + (let ((which-key-side-window-location loc1) + (which-key--multiple-locations t)) (setq pages1 (which-key--create-pages keys (window-width)))) (if (< 0 (plist-get pages1 :n-pages)) (progn (setq which-key--pages-plist pages1) - (let ((which-key-side-window-location loc1)) + (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)) + (let ((which-key-side-window-location loc2) + (which-key--multiple-locations t)) (setq which-key--pages-plist (which-key--create-pages keys (window-width))) (which-key--show-page page-n) commit 3a71cc13037b79cac802d4dc56db1f70bd957460 Author: Justin Burkett Date: Tue Oct 6 22:05:23 2015 -0400 Switch to defun in last commit diff --git a/which-key.el b/which-key.el index 862a2bf61eb..76c14442879 100644 --- a/which-key.el +++ b/which-key.el @@ -1100,7 +1100,7 @@ special (SPC,TAB,...) < single char < mod (C-,M-,...) < other." Uses `string-lessp' after applying lowercase." (string-lessp (downcase (cdr acons)) (downcase (cdr bcons)))) -(defsubst which-key-prefix-then-key-order (acons bcons) +(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'." commit e9aa7c37b8e48c4f187d5584cd04b26616fa2c23 Author: Justin Burkett Date: Tue Oct 6 21:55:48 2015 -0400 Add new sort function As suggested by @hmelman, sort by whether a key is a prefix or not (no prefix takes priority) then by key. diff --git a/which-key.el b/which-key.el index 9672d3c8ecf..862a2bf61eb 100644 --- a/which-key.el +++ b/which-key.el @@ -195,9 +195,16 @@ a percentage out of the frame's height." (const :tag "No" nil))) (defcustom which-key-sort-order 'which-key-key-order - "If nil, leave output unsorted. Set to `which-key-key-order' to -order by key or `which-key-description-order' to order by -description." + "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-description-order': by description +3. `which-key-prefix-then-key-order': prefix (no prefix first) then key + +See the README and the docstrings for those functions for more +information." :group 'which-key :type 'function) @@ -1080,18 +1087,28 @@ alists. Returns a list (key separator description)." ((or apr? bpr?) apr?) (t (string-lessp a b))))) -(defsubst which-key-key-order (alst blst) +(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 alst) (car blst))) + (which-key--key-description< (car acons) (car bcons))) -(defsubst which-key-description-order (alst blst) +(defsubst which-key-description-order (acons bcons) "Order descriptions of A and B. Uses `string-lessp' after applying lowercase." - (string-lessp (downcase (cdr alst)) (downcase (cdr blst)))) + (string-lessp (downcase (cdr acons)) (downcase (cdr bcons)))) + +(defsubst 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--get-formatted-key-bindings () "Uses `describe-buffer-bindings' to collect the key bindings in commit 0982ad358c12e602205cfdd98515b1c21b64bf77 Author: Justin Burkett Date: Tue Oct 6 10:25:32 2015 -0400 Bump version to 0.6.2 diff --git a/which-key.el b/which-key.el index f16ee70ccc2..9672d3c8ecf 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.6.1 +;; Version: 0.6.2 ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) commit caa70fe652e01d931208c428b350710f8456ef6a Author: Justin Burkett Date: Mon Oct 5 07:29:56 2015 -0400 readme: Remove what's new and add dependency note diff --git a/README.org b/README.org index e8329347164..2e3231f1cff 100644 --- a/README.org +++ b/README.org @@ -1,22 +1,5 @@ * which-key [[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]] -** What's new -*** Paging -- The new option =which-key-prevent-C-h-from-cycling=, which is =t= by default - allows one to take advantage of using =C-h= for paging as well as the default - Emacs behavior of using =C-h= to describe the bindings for the current key - sequence prefix. -- The (default) configuration below will allow you to switch paging using =C-h= - until you reach the last page of keys in the which-key buffer. The next press - of =C-h= will close the which-key buffer and trigger the default Emacs - behavior on =C-h=. - #+BEGIN_SRC Emacs-lisp - (setq which-key-use-C-h-for-paging t - which-key-prevent-C-h-from-cycling t) - #+END_SRC -- 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. ** Introduction =which-key= is a minor mode for Emacs that displays the key bindings following your currently @@ -43,12 +26,11 @@ Many of these have been implemented and are described below. ** Table of Contents :TOC@4: - [[#which-key-][which-key ]] - - [[#whats-new][What's new]] - - [[#paging][Paging]] - [[#introduction][Introduction]] - [[#install][Install]] - [[#melpa][MELPA]] - [[#manually][Manually]] + - [[#dependencies][Dependencies]] - [[#initial-setup][Initial Setup]] - [[#side-window-bottom-option][Side Window Bottom Option]] - [[#side-window-right-option][Side Window Right Option]] @@ -89,6 +71,11 @@ Add which-key.el to your =load-path= and require. Something like (which-key-mode) #+END_SRC +**** Dependencies + +Which-key requires recent versions of the packages [[https://github.com/magnars/dash.el][dash]] and [[https://github.com/magnars/s.el][s]]. These are +installed automatically if installed via MELPA. + ** 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 @@ -345,9 +332,10 @@ allows one to take advantage of using =C-h= for paging as well as the default Emacs behavior of using =C-h= to describe the bindings for the current key sequence prefix. -The configuration below will allow you to switch paging using =C-h= until you -reach the last page of keys in the which-key buffer. The next press of =C-h= -will close the which-key buffer and trigger the default Emacs behavior on =C-h=. +The default configuration below will allow you to switch paging using =C-h= +until you reach the last page of keys in the which-key buffer. The next press of +=C-h= will close the which-key buffer and trigger the default Emacs behavior on +=C-h=. #+BEGIN_SRC Emacs-lisp (setq which-key-use-C-h-for-paging t which-key-prevent-C-h-from-cycling t) commit d2e3a09d875bc0ae3bb106b11d11de18ac9ee7e2 Merge: 0533cdc2bb4 1ef76a93417 Author: Justin Burkett Date: Sat Oct 3 14:38:00 2015 -0400 Merge pull request #71 from justbur/refactor Refactor commit 1ef76a93417367eda500c32693e35d58e62c35a6 Author: Justin Burkett Date: Sat Oct 3 14:22:29 2015 -0400 Remove comment diff --git a/which-key.el b/which-key.el index 37a1412b96d..f16ee70ccc2 100644 --- a/which-key.el +++ b/which-key.el @@ -1414,7 +1414,7 @@ Finally, show the buffer." (defun which-key--start-timer () "Activate idle timer to trigger `which-key--update'." - (which-key--stop-timer) ; start over + (which-key--stop-timer) (setq which-key--timer (run-with-idle-timer which-key-idle-delay t #'which-key--update))) commit a1806395820ed99154ba09160d159717abf7eb20 Author: Justin Burkett Date: Sat Oct 3 13:41:00 2015 -0400 Refactor show-next-page diff --git a/which-key.el b/which-key.el index f2fe6c51918..37a1412b96d 100644 --- a/which-key.el +++ b/which-key.el @@ -1318,49 +1318,39 @@ enough space based on your settings and frame size." prefix-keys) "Show the next page of keys. Will force an update if called before `which-key--update'." (interactive) - (if (and which-key--current-page-n - which-key--on-last-page - which-key-use-C-h-for-paging - which-key-prevent-C-h-from-cycling) - (progn - (which-key--hide-popup-ignore-command) - (which-key--stop-timer) - (funcall which-key--prefix-help-cmd-backup) - (which-key--start-timer)) - (let* ((next-event-if-showing - ;; forces event into current key sequence - (mapcar (lambda (ev) (cons t ev)) - (which-key--current-key-list))) - (keysbl + (cond + ;; on last page and want default C-h behavior + ((and which-key--current-page-n + which-key--on-last-page + which-key-use-C-h-for-paging + which-key-prevent-C-h-from-cycling) + (which-key--hide-popup-ignore-command) + (which-key--stop-timer) + (funcall which-key--prefix-help-cmd-backup) + (which-key--start-timer)) + ;; No which-key buffer showing + ((null which-key--current-page-n) + (let* ((keysbl (vconcat (butlast (append (this-single-command-keys) nil)))) - (next-event-if-not-showing - (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence keysbl))) - (next-page - (if which-key--current-page-n (1+ which-key--current-page-n) 0))) - (cond - ;; buffer not showing - ((null which-key--current-page-n) - (which-key--stop-timer) - (setq unread-command-events next-event-if-not-showing) - (which-key--create-buffer-and-show keysbl) - (which-key--start-timer)) - (t - (which-key--stop-timer) - (setq unread-command-events next-event-if-showing) - (if which-key--last-try-2-loc - (let ((which-key-side-window-location which-key--last-try-2-loc)) - (which-key--show-page next-page)) - (which-key--show-page next-page)) - (which-key--start-paging-timer)))))) - -;; (defun which-key-show-first-page () -;; "Show the first page of keys." -;; ;; (which-key--stop-timer) -;; ;; (setq which-key--prefix-help-cmd-backup prefix-help-command -;; ;; prefix-help-command 'which-key-show-next-page) -;; (which-key--show-page 0) -;; ) -;; ;; (which-key--start-paging-timer)) + (next-event + (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence keysbl)))) + (which-key--stop-timer) + (setq unread-command-events next-event) + (which-key--create-buffer-and-show keysbl) + (which-key--start-timer))) + ;; which-key buffer showing. turn page + (t + (let ((next-event + (mapcar (lambda (ev) (cons t ev)) (which-key--current-key-list))) + (next-page + (if which-key--current-page-n (1+ which-key--current-page-n) 0))) + (which-key--stop-timer) + (setq unread-command-events next-event) + (if which-key--last-try-2-loc + (let ((which-key-side-window-location which-key--last-try-2-loc)) + (which-key--show-page next-page)) + (which-key--show-page next-page)) + (which-key--start-paging-timer))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update @@ -1401,22 +1391,24 @@ Finally, show the buffer." (defun which-key--update () "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." - ;; Do not display the popup if a command is currently being executed - (unless this-command - (let ((prefix-keys (this-single-command-keys))) - ;; (when (> (length prefix-keys) 0) - ;; (message "key: %s" (key-description prefix-keys))) - ;; (when (> (length prefix-keys) 0) - ;; (message "key binding: %s" (key-binding prefix-keys))) - (when (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)) - (which-key--create-buffer-and-show prefix-keys))))) + (let ((prefix-keys (this-single-command-keys))) + ;; (when (> (length prefix-keys) 0) + ;; (message "key: %s" (key-description prefix-keys))) + ;; (when (> (length prefix-keys) 0) + ;; (message "key binding: %s" (key-binding prefix-keys))) + (when (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) + ;; Do not display the popup if a command is currently being + ;; executed + (null this-command)) + (which-key--create-buffer-and-show prefix-keys)))) ;; Timers commit 0533cdc2bb46f186a137df730eb43b4c868513b3 Author: Justin Burkett Date: Sat Oct 3 13:20:35 2015 -0400 Move golden-ratio-mode let binding Let bind golden-ratio-mode earlier in show-page function which may help prevent golden-ratio from moving the whihc-key buffer diff --git a/which-key.el b/which-key.el index b5ac9be3d6c..f2fe6c51918 100644 --- a/which-key.el +++ b/which-key.el @@ -732,14 +732,13 @@ total height." 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." - (let (golden-ratio-mode) - (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)))))) + (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'. @@ -1257,7 +1256,7 @@ area." (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) + 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) commit b07a24311082c810c953f67d77d5d121f2b06346 Author: Iqbal Ansari Date: Fri Oct 2 19:31:15 2015 +0530 Do not display which-key popup if an interactive command is in progress This prevents the which-key popup from being displayed if `read-key-sequence` is invoked from a command as opposed to the editor's main loop. The changes introduced in #b96481 and #6d20c0 have been removed since they are not needed now diff --git a/which-key.el b/which-key.el index 3412a50a648..b5ac9be3d6c 100644 --- a/which-key.el +++ b/which-key.el @@ -384,7 +384,6 @@ alongside the actual current key sequence when (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 'post-command-hook #'which-key--hide-popup) (add-hook 'focus-out-hook #'which-key--stop-timer) (add-hook 'focus-in-hook #'which-key--start-timer) (which-key--start-timer)) @@ -394,7 +393,6 @@ alongside the actual current key sequence when (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 'post-command-hook #'which-key--hide-popup) (remove-hook 'focus-out-hook #'which-key--stop-timer) (remove-hook 'focus-in-hook #'which-key--start-timer) (which-key--stop-timer))) @@ -1404,20 +1402,22 @@ Finally, show the buffer." (defun which-key--update () "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." - (let ((prefix-keys (this-single-command-keys))) - ;; (when (> (length prefix-keys) 0) - ;; (message "key: %s" (key-description prefix-keys))) - ;; (when (> (length prefix-keys) 0) - ;; (message "key binding: %s" (key-binding prefix-keys))) - (when (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)) - (which-key--create-buffer-and-show prefix-keys)))) + ;; Do not display the popup if a command is currently being executed + (unless this-command + (let ((prefix-keys (this-single-command-keys))) + ;; (when (> (length prefix-keys) 0) + ;; (message "key: %s" (key-description prefix-keys))) + ;; (when (> (length prefix-keys) 0) + ;; (message "key binding: %s" (key-binding prefix-keys))) + (when (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)) + (which-key--create-buffer-and-show prefix-keys))))) ;; Timers commit 6d20c00c0a1a977b70912db536c104babef9f628 Author: Justin Burkett Date: Fri Oct 2 09:04:51 2015 -0400 Add remove-hook to previous commit diff --git a/which-key.el b/which-key.el index b0d50991ecf..3412a50a648 100644 --- a/which-key.el +++ b/which-key.el @@ -394,6 +394,7 @@ alongside the actual current key sequence when (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 'post-command-hook #'which-key--hide-popup) (remove-hook 'focus-out-hook #'which-key--stop-timer) (remove-hook 'focus-in-hook #'which-key--start-timer) (which-key--stop-timer))) commit b96481da28df1e9c54ed5075fcdec56fc2be1144 Author: Iqbal Ansari Date: Fri Oct 2 17:02:25 2015 +0530 Run `which-key--hide-popup` in post-command-hook also diff --git a/which-key.el b/which-key.el index 524517cae28..b0d50991ecf 100644 --- a/which-key.el +++ b/which-key.el @@ -384,6 +384,7 @@ alongside the actual current key sequence when (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 'post-command-hook #'which-key--hide-popup) (add-hook 'focus-out-hook #'which-key--stop-timer) (add-hook 'focus-in-hook #'which-key--start-timer) (which-key--start-timer)) commit 9493f2c425977f6c1b1ce4408e8d26e24beaacb6 Author: Justin Burkett Date: Thu Oct 1 20:22:37 2015 -0400 Revert preserve-size setting on buffer It's preventing the buffer from automatically shrinking diff --git a/which-key.el b/which-key.el index b7d8bb04f9f..524517cae28 100644 --- a/which-key.el +++ b/which-key.el @@ -752,8 +752,7 @@ call signature in different emacs versions" "Show which-key buffer when popup type is side-window." (let* ((side which-key-side-window-location) (alist '((window-width . which-key--fit-buffer-to-window-horizontally) - (window-height . (lambda (w) (fit-window-to-buffer w nil 1))) - (preserve-size . (t . t))))) + (window-height . (lambda (w) (fit-window-to-buffer w nil 1)))))) ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' ;; were added in Emacs 24.3 commit 48fd060b7675aee8c4a6cd31cc6a69f8fcf577ac Author: Justin Burkett Date: Tue Sep 29 11:36:48 2015 -0400 Let bind golden-ratio-mode when showing window Prevents golden-ratio from changing size of which-key buffer Fix #67 diff --git a/which-key.el b/which-key.el index fa827f5b49b..b7d8bb04f9f 100644 --- a/which-key.el +++ b/which-key.el @@ -732,13 +732,14 @@ total height." 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))))) + (let (golden-ratio-mode) + (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'. commit 26ec90203ab954a15a36e6fcf4ca0ee496adeb14 Author: Justin Burkett Date: Tue Sep 29 10:54:29 2015 -0400 Add preserve-size option to side-window display Beginning of fix for #67 diff --git a/which-key.el b/which-key.el index be2db0c06c1..fa827f5b49b 100644 --- a/which-key.el +++ b/which-key.el @@ -751,7 +751,8 @@ call signature in different emacs versions" "Show which-key buffer when popup type is side-window." (let* ((side which-key-side-window-location) (alist '((window-width . which-key--fit-buffer-to-window-horizontally) - (window-height . (lambda (w) (fit-window-to-buffer w nil 1)))))) + (window-height . (lambda (w) (fit-window-to-buffer w nil 1))) + (preserve-size . (t . t))))) ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' ;; were added in Emacs 24.3 commit 4b54f3e045eccfd40cf0817e54069d3f0a93e4b8 Author: Justin Burkett Date: Sun Sep 27 12:52:02 2015 -0400 Don't fail if buffer was killed somehow diff --git a/which-key.el b/which-key.el index 6c7bb050c5a..be2db0c06c1 100644 --- a/which-key.el +++ b/which-key.el @@ -397,6 +397,19 @@ alongside the actual current key sequence when (remove-hook 'focus-in-hook #'which-key--start-timer) (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)))) + (defun which-key--setup () "Initial setup for which-key. Reduce `echo-keystrokes' if necessary (it will interfer if it's @@ -405,15 +418,7 @@ set too high) and setup which-key buffer." (eq which-key-popup-type 'minibuffer)) (which-key--setup-echo-keystrokes)) (which-key--check-key-based-alist) - (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)) + (which-key--init-buffer) (setq which-key--is-setup t)) (defun which-key--setup-echo-keystrokes () @@ -1248,6 +1253,7 @@ area." (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) commit 49204b7f961f593b117e974c13240193a402d48b Merge: e5e5f7c978b 86d0613c7fc Author: Justin Burkett Date: Thu Sep 24 10:38:06 2015 -0400 Fix merge conflicts commit 86d0613c7fcd0cc18a2e15940fcf1eca43a129cd Author: Justin Burkett Date: Thu Sep 24 10:33:52 2015 -0400 Bump version diff --git a/which-key.el b/which-key.el index ddc1dc90bbd..6c7bb050c5a 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.5.1 +;; Version: 0.6.1 ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) commit 4ddf2777da0d9325a922cbc5671f7f60775e11af Author: Justin Burkett Date: Thu Sep 24 10:27:33 2015 -0400 Better fix for #65 Go back to using the original strategy of backing up `prefix-help-command` but make sure it never gets set to `which-key-show-next-page`. diff --git a/which-key.el b/which-key.el index 53a2574251f..ddc1dc90bbd 100644 --- a/which-key.el +++ b/which-key.el @@ -321,8 +321,8 @@ to a non-nil value for the execution of a command. Like this 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--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--lighter-backup nil @@ -377,6 +377,8 @@ alongside the actual current key sequence when (progn (setq which-key--echo-keystrokes-backup echo-keystrokes) (unless which-key--is-setup (which-key--setup)) + (unless (eq prefix-help-command 'which-key-show-next-page) + (setq which-key--prefix-help-cmd-backup prefix-help-command)) (when which-key-use-C-h-for-paging (setq prefix-help-command #'which-key-show-next-page)) (when which-key-show-remaining-keys @@ -386,6 +388,8 @@ alongside the actual current key sequence when (add-hook 'focus-in-hook #'which-key--start-timer) (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) @@ -1315,7 +1319,7 @@ Will force an update if called before `which-key--update'." (progn (which-key--hide-popup-ignore-command) (which-key--stop-timer) - (describe-prefix-bindings) + (funcall which-key--prefix-help-cmd-backup) (which-key--start-timer)) (let* ((next-event-if-showing ;; forces event into current key sequence commit e5e5f7c978b024badbf17704f19e6d5b0dbb000f Author: Justin Burkett Date: Thu Sep 24 10:22:29 2015 -0400 Revert "Fix #65" This reverts commit c1873df76dc8d1907405ccb8af8ef7a0da1c63e9. diff --git a/which-key.el b/which-key.el index 53a2574251f..e4d809815d4 100644 --- a/which-key.el +++ b/which-key.el @@ -321,8 +321,8 @@ to a non-nil value for the execution of a command. Like this 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--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--lighter-backup nil @@ -377,6 +377,7 @@ alongside the actual current key sequence when (progn (setq which-key--echo-keystrokes-backup echo-keystrokes) (unless which-key--is-setup (which-key--setup)) + (setq which-key--prefix-help-cmd-backup prefix-help-command) (when which-key-use-C-h-for-paging (setq prefix-help-command #'which-key-show-next-page)) (when which-key-show-remaining-keys @@ -386,6 +387,7 @@ alongside the actual current key sequence when (add-hook 'focus-in-hook #'which-key--start-timer) (which-key--start-timer)) (setq echo-keystrokes which-key--echo-keystrokes-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) @@ -1315,7 +1317,7 @@ Will force an update if called before `which-key--update'." (progn (which-key--hide-popup-ignore-command) (which-key--stop-timer) - (describe-prefix-bindings) + (funcall which-key--prefix-help-cmd-backup) (which-key--start-timer)) (let* ((next-event-if-showing ;; forces event into current key sequence commit c1873df76dc8d1907405ccb8af8ef7a0da1c63e9 Author: Justin Burkett Date: Wed Sep 23 14:00:46 2015 -0400 Fix #65 Don't try to backup the value of `prefix-help-command` because it was getting set to `which-key-show-next-page` somehow creating an infinite recursion error. Just call `describe-prefix-bindings` directly, which should cover almost all cases. diff --git a/which-key.el b/which-key.el index e4d809815d4..53a2574251f 100644 --- a/which-key.el +++ b/which-key.el @@ -321,8 +321,8 @@ to a non-nil value for the execution of a command. Like this 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--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--lighter-backup nil @@ -377,7 +377,6 @@ alongside the actual current key sequence when (progn (setq which-key--echo-keystrokes-backup echo-keystrokes) (unless which-key--is-setup (which-key--setup)) - (setq which-key--prefix-help-cmd-backup prefix-help-command) (when which-key-use-C-h-for-paging (setq prefix-help-command #'which-key-show-next-page)) (when which-key-show-remaining-keys @@ -387,7 +386,6 @@ alongside the actual current key sequence when (add-hook 'focus-in-hook #'which-key--start-timer) (which-key--start-timer)) (setq echo-keystrokes which-key--echo-keystrokes-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) @@ -1317,7 +1315,7 @@ Will force an update if called before `which-key--update'." (progn (which-key--hide-popup-ignore-command) (which-key--stop-timer) - (funcall which-key--prefix-help-cmd-backup) + (describe-prefix-bindings) (which-key--start-timer)) (let* ((next-event-if-showing ;; forces event into current key sequence commit df53b5d11cf507b68c2b8ec9d566981d241667f4 Author: Justin Burkett Date: Tue Sep 22 09:07:11 2015 -0400 Fix docstring typo Thanks @hmelman diff --git a/which-key.el b/which-key.el index 91200c75083..e4d809815d4 100644 --- a/which-key.el +++ b/which-key.el @@ -262,7 +262,7 @@ prefixes in `which-key-paging-prefixes'" (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-face'." +and it matches a string in `which-key-highlighted-command-list'." :group 'which-key-faces) (defface which-key-group-description-face commit 74a372468ea13f5331752a8661cdcd90fd7a4500 Author: Justin Burkett Date: Sun Sep 20 21:26:11 2015 -0400 Add alist-name arg to add-key-val-to-alist Otherwise the name of the alist is not available to this function diff --git a/which-key.el b/which-key.el index 960077f3c04..91200c75083 100644 --- a/which-key.el +++ b/which-key.el @@ -499,7 +499,7 @@ bottom." ;; Helper functions to modify replacement lists. -(defun which-key--add-key-val-to-alist (alist key value) +(defun which-key--add-key-val-to-alist (alist key value &optional alist-name) "Internal function to add (KEY . VALUE) to ALIST." (when (or (not (stringp key)) (not (stringp value))) (error "which-key: Error %s (key) and %s (value) should be strings" @@ -507,8 +507,8 @@ bottom." (let ((key-lst (listify-key-sequence (kbd key)))) (cond ((null alist) (list (cons key-lst value))) ((assoc key-lst alist) - (message "which-key: changing %s name from %s to %s in %s" - key (cdr (assoc key-lst alist)) value alist) + (message "which-key: changing %s name from %s to %s in the %s alist" + key (cdr (assoc key-lst alist)) value alist-name) (setcdr (assoc key-lst alist) value) alist) (t (cons (cons key-lst value) alist))))) @@ -528,7 +528,7 @@ replacements are added to (setq which-key-key-based-description-replacement-alist (which-key--add-key-val-to-alist which-key-key-based-description-replacement-alist - key-sequence replacement)) + key-sequence replacement "key-based")) (setq key-sequence (pop more) replacement (pop more)))) (put 'which-key-add-key-based-replacements 'lisp-indent-function 'defun) @@ -543,7 +543,9 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (error "MODE should be a symbol corresponding to a value of major-mode")) (let ((mode-alist (cdr (assq mode which-key-key-based-description-replacement-alist)))) (while key-sequence - (setq mode-alist (which-key--add-key-val-to-alist mode-alist key-sequence replacement)) + (setq mode-alist (which-key--add-key-val-to-alist + mode-alist key-sequence replacement + (format "key-based-%s" mode))) (setq key-sequence (pop more) replacement (pop more))) (if (assq mode which-key-key-based-description-replacement-alist) (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) @@ -585,11 +587,11 @@ to `which-key-prefix-title-alist'." (let ((-name (if (consp name) (car name) name)) (-title (if (consp name) (cdr name) name))) (setq which-key-prefix-name-alist - (which-key--add-key-val-to-alist which-key-prefix-name-alist - key-sequence -name) + (which-key--add-key-val-to-alist + which-key-prefix-name-alist key-sequence -name "prefix-name") which-key-prefix-title-alist - (which-key--add-key-val-to-alist which-key-prefix-title-alist - key-sequence -title))) + (which-key--add-key-val-to-alist + which-key-prefix-title-alist key-sequence -title "prefix-title"))) (setq key-sequence (pop more) name (pop more)))) (put 'which-key-declare-prefixes 'lisp-indent-function 'defun) @@ -607,9 +609,11 @@ addition KEY-SEQUENCE NAME pairs) to apply." (-title (if (consp name) (cdr name) name))) (while key-sequence (setq mode-name-alist (which-key--add-key-val-to-alist - mode-name-alist key-sequence -name) + mode-name-alist key-sequence -name + (format "prefix-name-%s" mode)) mode-title-alist (which-key--add-key-val-to-alist - mode-title-alist key-sequence -title)) + mode-title-alist key-sequence -title + (format "prefix-name-%s" mode))) (setq key-sequence (pop more) name (pop more))) (if (assq mode which-key-prefix-name-alist) (setcdr (assq mode which-key-prefix-name-alist) mode-name-alist) commit 6a5c2410dd01a811226480c93cfde3263d7ee43c Author: Justin Burkett Date: Sun Sep 20 20:59:01 2015 -0400 Add faces group diff --git a/which-key.el b/which-key.el index 4bd59f572e6..960077f3c04 100644 --- a/which-key.el +++ b/which-key.el @@ -229,46 +229,51 @@ prefixes in `which-key-paging-prefixes'" :type 'boolean) ;; 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) + :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) + :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) + :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) + :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) + :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-face'." - :group 'which-key) + :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) + :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) + :group 'which-key-faces) ;; Custom popup (defcustom which-key-custom-popup-max-dimensions-function nil commit db263bc2d6ef1d0490f859d70cf03887fed7d639 Author: Justin Burkett Date: Sat Sep 19 11:10:58 2015 -0400 Better messages for add-key-val-to-alist diff --git a/which-key.el b/which-key.el index 028a99629aa..4bd59f572e6 100644 --- a/which-key.el +++ b/which-key.el @@ -497,12 +497,13 @@ bottom." (defun which-key--add-key-val-to-alist (alist key value) "Internal function to add (KEY . VALUE) to ALIST." (when (or (not (stringp key)) (not (stringp value))) - (error "KEY and VALUE should be strings")) + (error "which-key: Error %s (key) and %s (value) should be strings" + key value)) (let ((key-lst (listify-key-sequence (kbd key)))) (cond ((null alist) (list (cons key-lst value))) ((assoc key-lst alist) - (message "which-key: changing %s name from %s to %s" - key (cdr (assoc key-lst alist)) value) + (message "which-key: changing %s name from %s to %s in %s" + key (cdr (assoc key-lst alist)) value alist) (setcdr (assoc key-lst alist) value) alist) (t (cons (cons key-lst value) alist))))) commit acf30ee10a84c8069fec2f37c97e1a84e62a38a5 Author: Justin Burkett Date: Fri Sep 18 13:19:48 2015 -0400 Remove some alists from customize and update docs The helper functions should be used now due to the nature of the lists. Removing the variables from customize should encourage this. Also add automatic conversion of old format of `which-key-key-based-description-replacement-alist`. diff --git a/README.org b/README.org index ed9c48457fb..e8329347164 100644 --- a/README.org +++ b/README.org @@ -244,42 +244,34 @@ 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 -The relevant variable is the awkwardly named -=which-key-key-based-description-replacement-alist= (Note on 3/9/2015 the -internal format of this list changed). In this alist you can have cons cells of -two types. An example of the first type is +[Note on 2015-9-3 the format of +=which-key-key-based-description-replacement-alist= changed. It will be easier +to use the functions below in your configuration, instead of modifying this +variable directly.] + +Using this method, the description of a key is replaced using a string that you +provide. Here's an example #+BEGIN_SRC Emacs-lisp -((listify-key-sequence (kbd "C-x C-f")) . "find files") +(which-key-add-key-based-replacements + "C-x C-f" "find files") #+END_SRC -where the string on the left is the key combination whose description you want -to replace, stored in a canonical form. For that key combination, which-key +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 -(org-mode . (((listify-key-sequence (kbd "C-c C-c")) . "Org C-c C-c") - ((listify-key-sequence (kbd "C-c C-a")) . "Org Attach")) -#+END_SRC - -Here the first entry is the major-mode and the second is 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 will take precedence. - -To simplify adding these entries, there are two helper functions to add entries -to this list, =which-key-add-key-based-replacements= and -=which-key-add-major-mode-key-based-replacements=. With these functions the -above examples become - -#+BEGIN_SRC Emacs-lisp -(which-key-add-key-based-replacements - "C-x C-f" "find files") (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 diff --git a/which-key.el b/which-key.el index 95bdca90666..028a99629aa 100644 --- a/which-key.el +++ b/which-key.el @@ -104,21 +104,6 @@ This is a list of lists for replacing descriptions." :group 'which-key :type '(alist :key-type regexp :value-type string)) -(defcustom which-key-key-based-description-replacement-alist '() - "Each item in the list is a cons cell. -The car of each cons cell is either a string like \"C-c\", in -which case it's interpreted as a key sequence or a value of -`major-mode'. Here are two examples: - -(\"SPC f f\" . \"find files\") -(emacs-lisp-mode . ((\"SPC m d\" . \"debug\"))) - -In the first case the description of the key sequence \"SPC f f\" -is overwritten with \"find files\". The second case works the -same way using the alist matched when `major-mode' is -emacs-lisp-mode." - :group 'which-key) - (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 @@ -126,25 +111,7 @@ 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-key-based-description-replacement-alist) - -(defcustom which-key-prefix-name-alist '() - "An alist with elements of the form (key-sequence . prefix-name). -key-sequence is a sequence of the sort produced by applying `kbd' -then `listify-key-sequence' to create a canonical version of the -key sequence. prefix-name is a string." - :group 'which-key - :type '(alist :key-type string :value-type string)) - -(defcustom which-key-prefix-title-alist '() - "An alist with elements of the form (key-sequence . prefix-title). -key-sequence is a sequence of the sort produced by applying `kbd' -then `listify-key-sequence' to create a canonical version of the -key sequence. prefix-title is a string. The title is displayed -alongside the actual current key sequence when -`which-key-show-prefix' is set to either top or echo." - :group 'which-key - :type '(alist :key-type string :value-type string)) + :group 'which-key) (defcustom which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") "These keys will automatically be truncated to one character @@ -366,6 +333,28 @@ showing.") "Internal: Last location of side-window when two locations used.") +(defvar which-key-key-based-description-replacement-alist '() + "New version of +`which-key-key-based-description-replacement-alist'. Use +`which-key-add-key-based-replacements' or +`which-key-add-major-mode-key-based-replacements' to set this +variable.") + +(defvar which-key-prefix-name-alist '() + "An alist with elements of the form (key-sequence . prefix-name). +key-sequence is a sequence of the sort produced by applying `kbd' +then `listify-key-sequence' to create a canonical version of the +key sequence. prefix-name is a string.") + +(defvar which-key-prefix-title-alist '() + "An alist with elements of the form (key-sequence . prefix-title). +key-sequence is a sequence of the sort produced by applying `kbd' +then `listify-key-sequence' to create a canonical version of the +key sequence. prefix-title is a string. The title is displayed +alongside the actual current key sequence when +`which-key-show-prefix' is set to either top or echo.") + + ;;;###autoload (define-minor-mode which-key-mode "Toggle which-key-mode." @@ -408,6 +397,7 @@ set too high) and setup which-key buffer." (when (or (eq which-key-show-prefix 'echo) (eq which-key-popup-type 'minibuffer)) (which-key--setup-echo-keystrokes)) + (which-key--check-key-based-alist) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer ;; suppress confusing minibuffer message @@ -434,6 +424,36 @@ it's set too high)." ;; previous echo-keystrokes) ))) +(defun which-key--check-key-based-alist () + "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'" + (let ((alist which-key-key-based-description-replacement-alist) + old-style res) + (dolist (cns alist) + (cond ((listp (car cns)) + (push cns res)) + ((stringp (car cns)) + (setq old-style t) + (push (cons (listify-key-sequence (kbd (car cns))) (cdr cns)) res)) + ((symbolp (car cns)) + (let (new-mode-alist) + (dolist (cns2 (cdr cns)) + (cond ((listp (car cns2)) + (push cns2 new-mode-alist)) + ((stringp (car cns2)) + (setq old-style t) + (push (cons (listify-key-sequence (kbd (car cns2))) (cdr cns2)) + new-mode-alist)))) + (push (cons (car cns) new-mode-alist) res))) + (t (message "which-key: there's a problem with the \ +entry %s in which-key-key-based-replacement-alist" cns)))) + (setq which-key-key-based-description-replacement-alist res) + (when old-style + (message "which-key: \ + `which-key-key-based-description-replacement-alist' has changed format and you\ + seem to be using the old format. Please use the functions \ +`which-key-add-key-based-replacements' and \ +`which-key-add-major-mode-key-based-replacements' instead.")))) + ;; Default configuration functions for use by users. Should be the "best" ;; configurations commit f865977df3e7dd2898e7fdc19a3968133f3b449f Author: Justin Burkett Date: Fri Sep 18 11:20:00 2015 -0400 Update README for key-based replacements diff --git a/README.org b/README.org index ffc899f90b8..ed9c48457fb 100644 --- a/README.org +++ b/README.org @@ -245,30 +245,40 @@ cons cell and the replacement string in the =cdr=. **** "Key-Based" replacement The relevant variable is the awkwardly named -=which-key-key-based-description-replacement-alist=. In this alist you can have -cons cells of two types. An example of the first type is +=which-key-key-based-description-replacement-alist= (Note on 3/9/2015 the +internal format of this list changed). In this alist you can have cons cells of +two types. An example of the first type is #+BEGIN_SRC Emacs-lisp -("C-x C-f" . "find files") +((listify-key-sequence (kbd "C-x C-f")) . "find files") #+END_SRC where the string on the left is the key combination whose description you want -to replace. 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, +to replace, stored in a canonical form. 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 -(org-mode . (("C-c C-c" . "Org C-c C-c") ("C-c C-a" . "Org Attach")) +(org-mode . (((listify-key-sequence (kbd "C-c C-c")) . "Org C-c C-c") + ((listify-key-sequence (kbd "C-c C-a")) . "Org Attach")) #+END_SRC Here the first entry is the major-mode and the second is 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 will take precedence. -There are two helper functions to add entries to this list, -=which-key-add-key-based-replacements= and -=which-key-add-major-mode-key-based-replacements=. You can modify the alist -directly or use these. +To simplify adding these entries, there are two helper functions to add entries +to this list, =which-key-add-key-based-replacements= and +=which-key-add-major-mode-key-based-replacements=. With these functions the +above examples become + +#+BEGIN_SRC Emacs-lisp +(which-key-add-key-based-replacements + "C-x C-f" "find files") +(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 **** Key and Description replacement commit 4d7363df197894ca5fcdc0c1f9e509d8f16aaedf Author: Justin Burkett Date: Wed Sep 16 12:16:34 2015 -0400 Add ability to highlight certain commands Adds `which-key-highlighted-command-list` and `which-key-highlighted-command-face` as user-customizable means of highlighting arbitrary commands (selected through regexp) with arbitrary faces. diff --git a/which-key.el b/which-key.el index 581c4a73186..95bdca90666 100644 --- a/which-key.el +++ b/which-key.el @@ -117,7 +117,16 @@ In the first case the description of the key sequence \"SPC f f\" is overwritten with \"find files\". The second case works the same way using the alist matched when `major-mode' is emacs-lisp-mode." -:group 'which-key) + :group 'which-key) + +(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-key-based-description-replacement-alist) (defcustom which-key-prefix-name-alist '() "An alist with elements of the form (key-sequence . prefix-name). @@ -278,6 +287,12 @@ prefixes in `which-key-paging-prefixes'" "Face for the key description when it is found in `current-local-map'" :group 'which-key) +(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-face'." + :group 'which-key) + (defface which-key-group-description-face '((t . (:inherit font-lock-keyword-face))) "Face for the key description when it is a group or prefix" @@ -938,7 +953,24 @@ If KEY contains any \"special keys\" defined in (or (string-match-p "^\\(group:\\|Prefix\\)" description) (keymapp (intern description)))) -(defun which-key--propertize-description (description group local) +(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) "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 @@ -949,7 +981,8 @@ removing a \"group:\" prefix." (desc (if group (concat "+" desc) desc)) (desc (which-key--truncate-description desc))) (propertize desc 'face - (cond (group 'which-key-group-description-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))))) @@ -969,6 +1002,7 @@ alists. Returns a list (key separator description)." (key-lst (which-key--current-key-list key)) (local (eq (which-key--safe-lookup-key local-map (kbd keys)) (intern desc))) + (hl-face (which-key--highlight-face desc)) (key (which-key--maybe-replace key which-key-key-replacement-alist)) (desc (which-key--maybe-replace @@ -978,7 +1012,7 @@ alists. Returns a list (key separator description)." (which-key--maybe-replace-prefix-name key-lst desc) desc)) (key-w-face (which-key--propertize-key key)) - (desc-w-face (which-key--propertize-description desc group local))) + (desc-w-face (which-key--propertize-description desc group local hl-face))) (list key-w-face sep-w-face desc-w-face))) unformatted))) commit 5761b07b57715046da026406510c983e7493c9fb Author: Justin Burkett Date: Wed Sep 9 11:21:50 2015 -0400 typo in readme diff --git a/README.org b/README.org index d8eb11c459a..ffc899f90b8 100644 --- a/README.org +++ b/README.org @@ -338,7 +338,7 @@ keystroke can complete the command. As a bonus you can type =C-x C-h= and the which-key buffer will pop up immediately (i.e., before =which-key-idle-delay= kicks in). -The option =which-key-prevent-C-h-from-cycling=, which is =nil= by default +The option =which-key-prevent-C-h-from-cycling=, which is =t= by default allows one to take advantage of using =C-h= for paging as well as the default Emacs behavior of using =C-h= to describe the bindings for the current key sequence prefix. commit 358ebaca5dc16917ff827f5b42b9cf07775580e4 Author: Justin Burkett Date: Tue Sep 8 06:31:52 2015 -0400 Mute echo-keystrokes message It seems to be too much information to display on *every* startup diff --git a/which-key.el b/which-key.el index 506a95c9a2c..581c4a73186 100644 --- a/which-key.el +++ b/which-key.el @@ -407,15 +407,17 @@ set too high) and setup which-key buffer." (defun which-key--setup-echo-keystrokes () "Reduce `echo-keystrokes' if necessary (it will interfer if it's set too high)." - (let ((previous echo-keystrokes)) + (let (;(previous echo-keystrokes) + ) (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)) - (message "which-key: echo-keystrokes changed from %s to %s" - previous echo-keystrokes)))) + ;; (message "which-key: echo-keystrokes changed from %s to %s" + ;; previous echo-keystrokes) + ))) ;; Default configuration functions for use by users. Should be the "best" ;; configurations commit e0c80e3ab5367aabeeaf6e815609be6f393bf329 Author: Justin Burkett Date: Thu Sep 3 15:22:16 2015 -0400 Better warning for add-key-val-to-alist diff --git a/which-key.el b/which-key.el index d9e7b3a2ffe..506a95c9a2c 100644 --- a/which-key.el +++ b/which-key.el @@ -464,9 +464,8 @@ bottom." (let ((key-lst (listify-key-sequence (kbd key)))) (cond ((null alist) (list (cons key-lst value))) ((assoc key-lst alist) - (message "which-key: the key %s already exists in %s. This addition \ -will override that value." - key alist) + (message "which-key: changing %s name from %s to %s" + key (cdr (assoc key-lst alist)) value) (setcdr (assoc key-lst alist) value) alist) (t (cons (cons key-lst value) alist))))) commit 8b5d4c1dd2fc5c932d3d894d647ae82a415b2b4c Author: Justin Burkett Date: Thu Sep 3 13:19:42 2015 -0400 Fix typo diff --git a/which-key.el b/which-key.el index d4ab3183306..d9e7b3a2ffe 100644 --- a/which-key.el +++ b/which-key.el @@ -564,9 +564,9 @@ addition KEY-SEQUENCE NAME pairs) to apply." (-name (if (consp name) (car name) name)) (-title (if (consp name) (cdr name) name))) (while key-sequence - (setq mode-name-alist (which-key--add-key-val-to-list + (setq mode-name-alist (which-key--add-key-val-to-alist mode-name-alist key-sequence -name) - mode-title-alist (which-key--add-key-val-to-list + mode-title-alist (which-key--add-key-val-to-alist mode-title-alist key-sequence -title)) (setq key-sequence (pop more) name (pop more))) (if (assq mode which-key-prefix-name-alist) commit 5cfc20646f3158a41ac7b5708ef83fda97e2c15d Author: Justin Burkett Date: Thu Sep 3 13:11:12 2015 -0400 Minor fix on last commit diff --git a/which-key.el b/which-key.el index 44553931643..d4ab3183306 100644 --- a/which-key.el +++ b/which-key.el @@ -549,7 +549,7 @@ to `which-key-prefix-title-alist'." (which-key--add-key-val-to-alist which-key-prefix-title-alist key-sequence -title))) (setq key-sequence (pop more) name (pop more)))) -(put 'which-key-declare-prefix-names 'lisp-indent-function 'defun) +(put 'which-key-declare-prefixes 'lisp-indent-function 'defun) ;;;###autoload (defun which-key-declare-prefixes-for-mode (mode key-sequence name &rest more) @@ -572,7 +572,7 @@ addition KEY-SEQUENCE NAME pairs) to apply." (if (assq mode which-key-prefix-name-alist) (setcdr (assq mode which-key-prefix-name-alist) mode-name-alist) (push (cons mode mode-name-alist) which-key-prefix-name-alist)))) -(put 'which-key-declare-prefix-names-for-mode 'lisp-indent-function 'defun) +(put 'which-key-declare-prefixes-for-mode 'lisp-indent-function 'defun) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for computing window sizes commit 34dbf351234b4a477e3b0d8f46781f35b0a48c19 Author: Justin Burkett Date: Thu Sep 3 09:11:34 2015 -0400 Common interface for prefix names and titles diff --git a/which-key.el b/which-key.el index a9b394e46b4..44553931643 100644 --- a/which-key.el +++ b/which-key.el @@ -457,18 +457,19 @@ bottom." ;; Helper functions to modify replacement lists. -(defun which-key--add-key-based-replacements (alist key repl) - "Internal function to add (KEY . REPL) to ALIST." - (when (or (not (stringp key)) (not (stringp repl))) - (error "KEY and REPL should be strings")) - (cond ((null alist) (list (cons key repl))) - ((assoc-string key alist) - (message "which-key: the key %s already exists in %s. This addition \ -will override that replacement." - key alist) - (setcdr (assoc-string key alist) repl) - alist) - (t (cons (cons key repl) alist)))) +(defun which-key--add-key-val-to-alist (alist key value) + "Internal function to add (KEY . VALUE) to ALIST." + (when (or (not (stringp key)) (not (stringp value))) + (error "KEY and VALUE should be strings")) + (let ((key-lst (listify-key-sequence (kbd key)))) + (cond ((null alist) (list (cons key-lst value))) + ((assoc key-lst alist) + (message "which-key: the key %s already exists in %s. This addition \ +will override that value." + key alist) + (setcdr (assoc key-lst alist) value) + alist) + (t (cons (cons key-lst value) alist))))) ;;;###autoload (defun which-key-add-key-based-replacements (key-sequence replacement &rest more) @@ -483,7 +484,7 @@ replacements are added to ;; TODO: Make interactive (while key-sequence (setq which-key-key-based-description-replacement-alist - (which-key--add-key-based-replacements + (which-key--add-key-val-to-alist which-key-key-based-description-replacement-alist key-sequence replacement)) (setq key-sequence (pop more) replacement (pop more)))) @@ -500,7 +501,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (error "MODE should be a symbol corresponding to a value of major-mode")) (let ((mode-alist (cdr (assq mode which-key-key-based-description-replacement-alist)))) (while key-sequence - (setq mode-alist (which-key--add-key-based-replacements mode-alist key-sequence replacement)) + (setq mode-alist (which-key--add-key-val-to-alist mode-alist key-sequence replacement)) (setq key-sequence (pop more) replacement (pop more))) (if (assq mode which-key-key-based-description-replacement-alist) (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) @@ -509,63 +510,68 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." ;;;###autoload (defun which-key-add-prefix-title (key-seq-str title &optional force) - "Add title for KEY-SEQ-STR given by TITLE. -FORCE, if non-nil, will add the new title even if one already -exists. KEY-SEQ-STR should be a key sequence string suitable for -`kbd' and TITLE should be a string." - (interactive) + "Deprecated in favor of `which-key-declare-prefixes'. + +Add title for KEY-SEQ-STR given by TITLE. FORCE, if non-nil, will +add the new title even if one already exists. KEY-SEQ-STR should +be a key sequence string suitable for `kbd' and TITLE should be a +string." (let ((key-seq-lst (listify-key-sequence (kbd key-seq-str)))) (if (and (null force) (assoc key-seq-lst which-key-prefix-title-alist)) (message "which-key: Prefix title not added. A title exists for this prefix.") (push (cons key-seq-lst title) which-key-prefix-title-alist)))) -(defun which-key--declare-prefix-names (alist key name) - "Internal function to add (KEY . NAME) to ALIST." - (when (or (not (stringp key)) (not (stringp name))) - (error "KEY and NAME should be strings")) - (let ((key-lst (listify-key-sequence (kbd key)))) - (cond ((null alist) (list (cons key-lst name))) - ((assoc key-lst alist) - (message "which-key: the key %s already exists in %s. This addition \ -will override that prefix-name." - key-lst alist) - (setcdr (assoc key-lst alist) name) - alist) - (t (cons (cons key-lst name) alist))))) - ;;;###autoload -(defun which-key-declare-prefix-names (key-sequence name &rest more) +(defun which-key-declare-prefixes (key-sequence name &rest more) "Name the KEY-SEQUENCE prefix NAME. -Both KEY-SEQUENCE and NAME should be strings. For Example, +KEY-SEQUENCE should be a string, acceptable to `kbd'. NAME can be +a string or a cons cell of two strings. In the first case, the +string is used as both the name and the title (the title is +displayed in the echo area only). For Example, + +\(which-key-declare-prefixes \"C-x 8\" \"unicode\"\) + +or -\(which-key-declare-prefix-names \"C-x 8\" \"unicode\"\) +\(which-key-declare-prefixes \"C-x 8\" (\"unicode\" . \"Unicode Chararcters\")\) -MORE allows you to specifcy additional KEY-SEQUENCE NAME pairs. All -names are added to `which-key-prefix-names-alist'." +MORE allows you to specifcy additional KEY-SEQUENCE NAME pairs. +All names are added to `which-key-prefix-names-alist' and titles +to `which-key-prefix-title-alist'." (while key-sequence - (setq which-key-prefix-name-alist - (which-key--declare-prefix-names which-key-prefix-name-alist - key-sequence name)) + (let ((-name (if (consp name) (car name) name)) + (-title (if (consp name) (cdr name) name))) + (setq which-key-prefix-name-alist + (which-key--add-key-val-to-alist which-key-prefix-name-alist + key-sequence -name) + which-key-prefix-title-alist + (which-key--add-key-val-to-alist which-key-prefix-title-alist + key-sequence -title))) (setq key-sequence (pop more) name (pop more)))) (put 'which-key-declare-prefix-names 'lisp-indent-function 'defun) ;;;###autoload -(defun which-key-declare-prefix-names-for-mode (mode key-sequence name &rest more) +(defun which-key-declare-prefixes-for-mode (mode key-sequence name &rest more) "Functions like `which-key-declare-prefix-names'. The difference is that MODE specifies the `major-mode' that must be active for KEY-SEQUENCE and NAME (MORE contains addition KEY-SEQUENCE NAME pairs) to apply." (when (not (symbolp mode)) (error "MODE should be a symbol corresponding to a value of major-mode")) - (let ((mode-alist (cdr (assq mode which-key-prefix-name-alist)))) + (let ((mode-name-alist (cdr (assq mode which-key-prefix-name-alist))) + (mode-title-alist (cdr (assq mode which-key-prefix-title-alist))) + (-name (if (consp name) (car name) name)) + (-title (if (consp name) (cdr name) name))) (while key-sequence - (setq mode-alist (which-key--declare-prefix-names - mode-alist key-sequence name)) + (setq mode-name-alist (which-key--add-key-val-to-list + mode-name-alist key-sequence -name) + mode-title-alist (which-key--add-key-val-to-list + mode-title-alist key-sequence -title)) (setq key-sequence (pop more) name (pop more))) (if (assq mode which-key-prefix-name-alist) - (setcdr (assq mode which-key-prefix-name-alist) mode-alist) - (push (cons mode mode-alist) which-key-prefix-name-alist)))) + (setcdr (assq mode which-key-prefix-name-alist) mode-name-alist) + (push (cons mode mode-name-alist) which-key-prefix-name-alist)))) (put 'which-key-declare-prefix-names-for-mode 'lisp-indent-function 'defun) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -863,7 +869,11 @@ replacement occurs return the new STRING." (when key-str (listify-key-sequence (kbd key-str)))))) -(defun which-key--maybe-get-prefix-name (key-lst desc) +(defun which-key--maybe-replace-prefix-name (key-lst desc) + "KEY-LST is a list of keys produced by `listify-key-sequences' +and DESC is the description that is possibly replaced using the +`which-key-prefix-name-alist'. Whether or not a replacement +occurs return the new STRING." (let* ((alist which-key-prefix-name-alist) (res (assoc key-lst alist)) (mode-alist (assq major-mode alist)) @@ -872,15 +882,27 @@ replacement occurs return the new STRING." (res (cdr res)) (t desc)))) -(defun which-key--maybe-replace-key-based (string keys) - "KEYS is a key sequence like \"C-c C-c\" and STRING is the -description that is possibly replaced using the +(defun which-key--maybe-get-prefix-title (key-lst) + "KEY-LST is a list of keys produced by `listify-key-sequences'. +A title is possibly returned using `which-key-prefix-title-alist'. +An empty stiring is returned if no title exists." + (let* ((alist which-key-prefix-title-alist) + (res (assoc key-lst alist)) + (mode-alist (assq major-mode alist)) + (mode-res (when mode-alist (assoc key-lst mode-alist)))) + (cond (mode-res (cdr mode-res)) + (res (cdr res)) + (t "")))) + +(defun which-key--maybe-replace-key-based (string key-lst) + "KEY-LST is a list of keys produced by `listify-key-sequences' +and STRING is the description that is possibly replaced using the `which-key-key-based-description-replacement-alist'. Whether or not a replacement occurs return the new STRING." (let* ((alist which-key-key-based-description-replacement-alist) - (str-res (assoc-string keys alist)) + (str-res (assoc key-lst alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc-string keys mode-alist)))) + (mode-res (when mode-alist (assoc key-lst mode-alist)))) (cond (mode-res (cdr mode-res)) (str-res (cdr str-res)) (t string)))) @@ -950,9 +972,9 @@ alists. Returns a list (key separator description)." key which-key-key-replacement-alist)) (desc (which-key--maybe-replace desc which-key-description-replacement-alist)) - (desc (which-key--maybe-replace-key-based desc keys)) + (desc (which-key--maybe-replace-key-based desc key-lst)) (desc (if group - (which-key--maybe-get-prefix-name key-lst desc) + (which-key--maybe-replace-prefix-name key-lst desc) desc)) (key-w-face (which-key--propertize-key key)) (desc-w-face (which-key--propertize-description desc group local))) @@ -1177,12 +1199,9 @@ enough space based on your settings and frame size." prefix-keys) (dash-w-face (propertize "-" 'face 'which-key-key-face)) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) - (status-top (when (assoc (which-key--current-key-list) - which-key-prefix-title-alist) - (propertize - (cdr (assoc (which-key--current-key-list) - which-key-prefix-title-alist)) - 'face 'which-key-note-face))) + (status-top (propertize (which-key--maybe-get-prefix-title + (which-key--current-key-list)) + 'face 'which-key-note-face)) (status-top (concat status-top (when (< 1 n-pages) (propertize (format " (%s of %s)" commit e5ed7de51003751831555db8622b2ecf304e8e1a Author: Justin Burkett Date: Wed Sep 2 20:50:18 2015 -0400 Minor changes to key-seq functions diff --git a/which-key.el b/which-key.el index 3c7c3c00139..a9b394e46b4 100644 --- a/which-key.el +++ b/which-key.el @@ -852,14 +852,16 @@ replacement occurs return the new STRING." (replace-match (cdr repl) t literal new-string)))) new-string))) -(defsubst which-key--current-key-list (key-str) +(defsubst which-key--current-key-list (&optional key-str) (append (listify-key-sequence which-key--current-prefix) - (listify-key-sequence (kbd key-str)))) + (when key-str + (listify-key-sequence (kbd key-str))))) -(defsubst which-key--current-key-string (key-str) +(defsubst which-key--current-key-string (&optional key-str) (key-description (append (listify-key-sequence which-key--current-prefix) - (listify-key-sequence (kbd key-str))))) + (when key-str + (listify-key-sequence (kbd key-str)))))) (defun which-key--maybe-get-prefix-name (key-lst desc) (let* ((alist which-key-prefix-name-alist) @@ -1175,10 +1177,10 @@ enough space based on your settings and frame size." prefix-keys) (dash-w-face (propertize "-" 'face 'which-key-key-face)) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) - (status-top (when (assoc (which-key--current-key-list "") + (status-top (when (assoc (which-key--current-key-list) which-key-prefix-title-alist) (propertize - (cdr (assoc (which-key--current-key-list "") + (cdr (assoc (which-key--current-key-list) which-key-prefix-title-alist)) 'face 'which-key-note-face))) (status-top (concat status-top @@ -1236,7 +1238,7 @@ Will force an update if called before `which-key--update'." (let* ((next-event-if-showing ;; forces event into current key sequence (mapcar (lambda (ev) (cons t ev)) - (which-key--current-key-list ""))) + (which-key--current-key-list))) (keysbl (vconcat (butlast (append (this-single-command-keys) nil)))) (next-event-if-not-showing commit 2f45969ca972e0eabe92b25f91ecbf7c7c162fff Author: Justin Burkett Date: Wed Sep 2 20:36:39 2015 -0400 Change default indentation of helpers diff --git a/which-key.el b/which-key.el index d259bb53dd5..3c7c3c00139 100644 --- a/which-key.el +++ b/which-key.el @@ -487,6 +487,7 @@ replacements are added to which-key-key-based-description-replacement-alist key-sequence replacement)) (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) @@ -504,6 +505,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (if (assq mode which-key-key-based-description-replacement-alist) (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) +(put 'which-key-add-major-mode-key-based-replacements 'lisp-indent-function 'defun) ;;;###autoload (defun which-key-add-prefix-title (key-seq-str title &optional force) @@ -546,6 +548,7 @@ names are added to `which-key-prefix-names-alist'." (which-key--declare-prefix-names which-key-prefix-name-alist key-sequence name)) (setq key-sequence (pop more) name (pop more)))) +(put 'which-key-declare-prefix-names 'lisp-indent-function 'defun) ;;;###autoload (defun which-key-declare-prefix-names-for-mode (mode key-sequence name &rest more) @@ -563,6 +566,7 @@ addition KEY-SEQUENCE NAME pairs) to apply." (if (assq mode which-key-prefix-name-alist) (setcdr (assq mode which-key-prefix-name-alist) mode-alist) (push (cons mode mode-alist) which-key-prefix-name-alist)))) +(put 'which-key-declare-prefix-names-for-mode 'lisp-indent-function 'defun) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for computing window sizes commit 35717ee18b119c03d1bce79887aee9cab90c38b2 Author: Justin Burkett Date: Wed Sep 2 19:51:21 2015 -0400 Add support for prefix-names diff --git a/which-key.el b/which-key.el index 86fe9fb2156..d259bb53dd5 100644 --- a/which-key.el +++ b/which-key.el @@ -119,6 +119,14 @@ same way using the alist matched when `major-mode' is emacs-lisp-mode." :group 'which-key) +(defcustom which-key-prefix-name-alist '() + "An alist with elements of the form (key-sequence . prefix-name). +key-sequence is a sequence of the sort produced by applying `kbd' +then `listify-key-sequence' to create a canonical version of the +key sequence. prefix-name is a string." + :group 'which-key + :type '(alist :key-type string :value-type string)) + (defcustom which-key-prefix-title-alist '() "An alist with elements of the form (key-sequence . prefix-title). key-sequence is a sequence of the sort produced by applying `kbd' @@ -498,17 +506,63 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) ;;;###autoload -(defun which-key-add-prefix-title (key-seq-str name &optional force) +(defun which-key-add-prefix-title (key-seq-str title &optional force) "Add title for KEY-SEQ-STR given by TITLE. FORCE, if non-nil, will add the new title even if one already exists. KEY-SEQ-STR should be a key sequence string suitable for -`kbd' and NAME should be a string." +`kbd' and TITLE should be a string." (interactive) (let ((key-seq-lst (listify-key-sequence (kbd key-seq-str)))) (if (and (null force) (assoc key-seq-lst which-key-prefix-title-alist)) (message "which-key: Prefix title not added. A title exists for this prefix.") - (push (cons key-seq-lst name) which-key-prefix-title-alist)))) + (push (cons key-seq-lst title) which-key-prefix-title-alist)))) + +(defun which-key--declare-prefix-names (alist key name) + "Internal function to add (KEY . NAME) to ALIST." + (when (or (not (stringp key)) (not (stringp name))) + (error "KEY and NAME should be strings")) + (let ((key-lst (listify-key-sequence (kbd key)))) + (cond ((null alist) (list (cons key-lst name))) + ((assoc key-lst alist) + (message "which-key: the key %s already exists in %s. This addition \ +will override that prefix-name." + key-lst alist) + (setcdr (assoc key-lst alist) name) + alist) + (t (cons (cons key-lst name) alist))))) + +;;;###autoload +(defun which-key-declare-prefix-names (key-sequence name &rest more) + "Name the KEY-SEQUENCE prefix NAME. +Both KEY-SEQUENCE and NAME should be strings. For Example, + +\(which-key-declare-prefix-names \"C-x 8\" \"unicode\"\) + +MORE allows you to specifcy additional KEY-SEQUENCE NAME pairs. All +names are added to `which-key-prefix-names-alist'." + (while key-sequence + (setq which-key-prefix-name-alist + (which-key--declare-prefix-names which-key-prefix-name-alist + key-sequence name)) + (setq key-sequence (pop more) name (pop more)))) + +;;;###autoload +(defun which-key-declare-prefix-names-for-mode (mode key-sequence name &rest more) + "Functions like `which-key-declare-prefix-names'. +The difference is that MODE specifies the `major-mode' that must +be active for KEY-SEQUENCE and NAME (MORE contains +addition KEY-SEQUENCE NAME pairs) to apply." + (when (not (symbolp mode)) + (error "MODE should be a symbol corresponding to a value of major-mode")) + (let ((mode-alist (cdr (assq mode which-key-prefix-name-alist)))) + (while key-sequence + (setq mode-alist (which-key--declare-prefix-names + mode-alist key-sequence name)) + (setq key-sequence (pop more) name (pop more))) + (if (assq mode which-key-prefix-name-alist) + (setcdr (assq mode which-key-prefix-name-alist) mode-alist) + (push (cons mode mode-alist) which-key-prefix-name-alist)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for computing window sizes @@ -794,6 +848,24 @@ replacement occurs return the new STRING." (replace-match (cdr repl) t literal new-string)))) new-string))) +(defsubst which-key--current-key-list (key-str) + (append (listify-key-sequence which-key--current-prefix) + (listify-key-sequence (kbd key-str)))) + +(defsubst which-key--current-key-string (key-str) + (key-description + (append (listify-key-sequence which-key--current-prefix) + (listify-key-sequence (kbd key-str))))) + +(defun which-key--maybe-get-prefix-name (key-lst desc) + (let* ((alist which-key-prefix-name-alist) + (res (assoc key-lst alist)) + (mode-alist (assq major-mode alist)) + (mode-res (when mode-alist (assoc key-lst mode-alist)))) + (cond (mode-res (cdr mode-res)) + (res (cdr res)) + (t desc)))) + (defun which-key--maybe-replace-key-based (string keys) "KEYS is a key sequence like \"C-c C-c\" and STRING is the description that is possibly replaced using the @@ -864,13 +936,18 @@ alists. Returns a list (key separator description)." (let* ((key (car key-desc-cons)) (desc (cdr key-desc-cons)) (group (which-key--group-p desc)) - (keys (concat (key-description which-key--current-prefix) " " key)) - (local (eq (which-key--safe-lookup-key local-map (kbd keys)) (intern desc))) + (keys (which-key--current-key-string key)) + (key-lst (which-key--current-key-list key)) + (local (eq (which-key--safe-lookup-key local-map (kbd keys)) + (intern desc))) (key (which-key--maybe-replace key which-key-key-replacement-alist)) (desc (which-key--maybe-replace desc which-key-description-replacement-alist)) (desc (which-key--maybe-replace-key-based desc keys)) + (desc (if group + (which-key--maybe-get-prefix-name key-lst desc) + desc)) (key-w-face (which-key--propertize-key key)) (desc-w-face (which-key--propertize-description desc group local))) (list key-w-face sep-w-face desc-w-face))) @@ -1094,10 +1171,10 @@ enough space based on your settings and frame size." prefix-keys) (dash-w-face (propertize "-" 'face 'which-key-key-face)) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) - (status-top (when (assoc (listify-key-sequence which-key--current-prefix) + (status-top (when (assoc (which-key--current-key-list "") which-key-prefix-title-alist) (propertize - (cdr (assoc (listify-key-sequence which-key--current-prefix) + (cdr (assoc (which-key--current-key-list "") which-key-prefix-title-alist)) 'face 'which-key-note-face))) (status-top (concat status-top @@ -1155,12 +1232,11 @@ Will force an update if called before `which-key--update'." (let* ((next-event-if-showing ;; forces event into current key sequence (mapcar (lambda (ev) (cons t ev)) - (listify-key-sequence which-key--current-prefix))) + (which-key--current-key-list ""))) (keysbl (vconcat (butlast (append (this-single-command-keys) nil)))) (next-event-if-not-showing - (mapcar (lambda (ev) (cons t ev)) - (listify-key-sequence keysbl))) + (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence keysbl))) (next-page (if which-key--current-page-n (1+ which-key--current-page-n) 0))) (cond commit 73ff071ec3c9af48bb5d9db15e6be607205503b2 Author: Justin Burkett Date: Wed Sep 2 12:57:46 2015 -0400 Make preventing C-h cycling the default diff --git a/README.org b/README.org index 893d36dee3b..d8eb11c459a 100644 --- a/README.org +++ b/README.org @@ -2,14 +2,14 @@ [[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]] ** What's new *** Paging -- The new option =which-key-prevent-C-h-from-cycling=, which is =nil= by default +- The new option =which-key-prevent-C-h-from-cycling=, which is =t= by default allows one to take advantage of using =C-h= for paging as well as the default Emacs behavior of using =C-h= to describe the bindings for the current key sequence prefix. -- The configuration below will allow you to switch paging using =C-h= until you - reach the last page of keys in the which-key buffer. The next press of =C-h= - will close the which-key buffer and trigger the default Emacs behavior on - =C-h=. +- The (default) configuration below will allow you to switch paging using =C-h= + until you reach the last page of keys in the which-key buffer. The next press + of =C-h= will close the which-key buffer and trigger the default Emacs + behavior on =C-h=. #+BEGIN_SRC Emacs-lisp (setq which-key-use-C-h-for-paging t which-key-prevent-C-h-from-cycling t) diff --git a/which-key.el b/which-key.el index e57a63f1f3d..86fe9fb2156 100644 --- a/which-key.el +++ b/which-key.el @@ -235,13 +235,12 @@ prefixes in `which-key-paging-prefixes'" :group 'which-key :type 'boolean) -(defcustom which-key-prevent-C-h-from-cycling nil - "Experimental: When using C-h for paging, which-key overrides - the default behavior of calling `describe-prefix-bindings'. - Setting this variable to t makes it so that when on the last - page, pressing C-h calls the default function instead of - cycling pages. If you want which-key to cycle, set this to - nil." +(defcustom which-key-prevent-C-h-from-cycling t + "When using C-h for paging, which-key overrides the default + behavior of calling `describe-prefix-bindings'. Setting this + variable to t makes it so that when on the last page, pressing + C-h calls the default function instead of cycling pages. If you + want which-key to cycle, set this to nil." :group 'which-key :type 'boolean) commit f248e9093e6f54477a7639feed4b77894c45b00c Author: Justin Burkett Date: Wed Sep 2 12:51:47 2015 -0400 Allow disabling truncation diff --git a/which-key.el b/which-key.el index 37d8bb6a9aa..e57a63f1f3d 100644 --- a/which-key.el +++ b/which-key.el @@ -63,7 +63,7 @@ which-key popup." (defcustom which-key-max-description-length 27 "Truncate the description of keys to this length. -Also adds \"..\"." +Also adds \"..\". If nil, disable any truncation." :group 'which-key :type 'integer) @@ -829,7 +829,8 @@ If KEY contains any \"special keys\" defined in (defsubst which-key--truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." - (if (> (string-width desc) which-key-max-description-length) + (if (and which-key-max-description-length + (> (string-width desc) which-key-max-description-length)) (concat (substring desc 0 which-key-max-description-length) "..") desc)) commit 13c1feaeeb36eb6d77b252c25f95e7cd1b306a6e Author: Justin Burkett Date: Wed Sep 2 12:04:37 2015 -0400 Add min-display-lines option Ref #60 diff --git a/which-key.el b/which-key.el index c46dbff9663..37d8bb6a9aa 100644 --- a/which-key.el +++ b/which-key.el @@ -158,6 +158,12 @@ and nil. Nil turns the feature off." (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-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 @@ -1011,6 +1017,7 @@ is the width of the live window." (+ 2 (string-width prefix-w-face)))) (prefix-top (eq which-key-show-prefix 'top)) (avl-lines (if prefix-top (- max-lines 1) max-lines)) + (min-lines (min avl-lines which-key-min-display-lines)) (avl-width (if prefix-left (- max-width prefix-left) max-width)) (vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) @@ -1019,7 +1026,7 @@ is the width of the live window." (cond ((or vertical (> (plist-get result :n-pages) 1) (= 1 avl-lines)) result) ;; do a simple search for the smallest number of lines - (t (while (and (> avl-lines 1) (not found)) + (t (while (and (> avl-lines min-lines) (not found)) (setq avl-lines (- avl-lines 1) prev-result result result (which-key--partition-columns commit b015716afc3d621170c81f6859d754ae5ef28d3e Author: Justin Burkett Date: Wed Sep 2 08:51:53 2015 -0400 Shorten next page hint It's too long with the buffer on the right diff --git a/which-key.el b/which-key.el index 879a54d2b4e..c46dbff9663 100644 --- a/which-key.el +++ b/which-key.el @@ -1056,15 +1056,15 @@ area." (let* ((paging-key (concat prefix-keys " " which-key-paging-key)) (paging-key-bound (eq 'which-key-show-next-page (key-binding (kbd paging-key)))) - (key (if paging-key-bound which-key-paging-key "C-h or ?")) + (key (if paging-key-bound which-key-paging-key "C-h")) (next-page-n (format "pg %s" (1+ (mod (1+ page-n) n-pages)))) (use-descbind (and which-key--on-last-page which-key-use-C-h-for-paging which-key-prevent-C-h-from-cycling))) (when (or (and (< 1 n-pages) which-key-use-C-h-for-paging) (and (< 1 n-pages) paging-key-bound) use-descbind) - (propertize (format "[%s%s%s]" key which-key-separator - (if use-descbind "describe bindings" next-page-n)) + (propertize (format "[%s %s]" key + (if use-descbind "help" next-page-n)) 'face 'which-key-note-face)))) (defun which-key--show-page (n) commit 5f5fcc4282179c6181d3b3f4c5910fad24bb999f Author: Justin Burkett Date: Wed Sep 2 08:28:46 2015 -0400 Factor out next page hint diff --git a/which-key.el b/which-key.el index b55635f2b82..879a54d2b4e 100644 --- a/which-key.el +++ b/which-key.el @@ -1051,6 +1051,22 @@ area." delay nil (lambda () (let (message-log-max) (message "%s" text)))))) +(defun which-key--next-page-hint (prefix-keys page-n n-pages) + "Return string for next page hint." + (let* ((paging-key (concat prefix-keys " " which-key-paging-key)) + (paging-key-bound (eq 'which-key-show-next-page + (key-binding (kbd paging-key)))) + (key (if paging-key-bound which-key-paging-key "C-h or ?")) + (next-page-n (format "pg %s" (1+ (mod (1+ page-n) n-pages)))) + (use-descbind (and which-key--on-last-page which-key-use-C-h-for-paging + which-key-prevent-C-h-from-cycling))) + (when (or (and (< 1 n-pages) which-key-use-C-h-for-paging) + (and (< 1 n-pages) paging-key-bound) + use-descbind) + (propertize (format "[%s%s%s]" key which-key-separator + (if use-descbind "describe bindings" next-page-n)) + 'face 'which-key-note-face)))) + (defun which-key--show-page (n) "Show page N, starting from 0." (let ((n-pages (plist-get which-key--pages-plist :n-pages)) @@ -1076,7 +1092,7 @@ enough space based on your settings and frame size." prefix-keys) (propertize (cdr (assoc (listify-key-sequence which-key--current-prefix) which-key-prefix-title-alist)) - 'face 'which-key-note-face))) + 'face 'which-key-note-face))) (status-top (concat status-top (when (< 1 n-pages) (propertize (format " (%s of %s)" @@ -1086,29 +1102,7 @@ enough space based on your settings and frame size." prefix-keys) (string-width status-left)))) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) (status-left (s-pad-right first-col-width " " status-left)) - (nxt-pg-hint (cond ((and which-key--on-last-page - which-key-prevent-C-h-from-cycling - which-key-use-C-h-for-paging) - (propertize (format "[C-h or ?%sdescribe bindings]" - which-key-separator) - 'face 'which-key-note-face)) - ((and (< 1 n-pages) - which-key-use-C-h-for-paging) - (propertize (format "[C-h or ?%spg %s]" - which-key-separator - (1+ (mod (1+ page-n) n-pages))) - 'face 'which-key-note-face)) - ((and (< 1 n-pages) - (eq 'which-key-show-next-page - (key-binding - (kbd (concat prefix-keys - " " - which-key-paging-key))))) - (propertize (format "[%s pg %s]" - which-key-paging-key - (1+ (mod (1+ page-n) n-pages))) - 'face 'which-key-note-face)) - (t nil))) + (nxt-pg-hint (which-key--next-page-hint prefix-keys page-n n-pages)) new-end lines first) (cond ((and (< 1 n-pages) (eq which-key-show-prefix 'left)) commit c1458b621ad79e97cfdec15fd10b5326bcc63655 Author: Justin Burkett Date: Wed Sep 2 08:01:17 2015 -0400 Change wording of hint diff --git a/which-key.el b/which-key.el index 12d69e11a4e..b55635f2b82 100644 --- a/which-key.el +++ b/which-key.el @@ -1089,7 +1089,7 @@ enough space based on your settings and frame size." prefix-keys) (nxt-pg-hint (cond ((and which-key--on-last-page which-key-prevent-C-h-from-cycling which-key-use-C-h-for-paging) - (propertize (format "[C-h or ?%shelp]" + (propertize (format "[C-h or ?%sdescribe bindings]" which-key-separator) 'face 'which-key-note-face)) ((and (< 1 n-pages) commit 6bfda0168e4b947551d65d825b310635f9987403 Author: Justin Burkett Date: Wed Sep 2 07:21:48 2015 -0400 Add missing autoload Fix #60 diff --git a/which-key.el b/which-key.el index 51e03c64826..12d69e11a4e 100644 --- a/which-key.el +++ b/which-key.el @@ -415,8 +415,10 @@ it's set too high)." 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." + "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) commit 156bd61f46eb054ccbd863539d05c7e5d892b321 Author: Justin Burkett Date: Tue Sep 1 13:56:48 2015 -0400 Describe new paging options in readme diff --git a/README.org b/README.org index d0e15e4328f..893d36dee3b 100644 --- a/README.org +++ b/README.org @@ -1,29 +1,23 @@ * which-key [[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]] ** What's new -*** Local map face -- The face =which-key-local-map-description-face= is now available. This face - will be applied to any commands that are found using =(current-local-map)= - (commands defined for the major mode are usually here). This allows you to - distinguish between local and global bindings visually. See [[#face-customization-options][Face Customization]] - for more information. *** Paging -- Paging is now turned on by default, using any prefix plus =C-h= (this doesn't - affect key sequences that start with =C-h= and will not override any key - sequences that end will =C-h=). See the [[#paging-options][Paging Section]] for more details and - for other options on using and/or disabling paging. -- This makes which-key function as a replacement for the default behavior of - pressing =C-h= after a prefix which shows the key bindings for any prefix - (this default command is =describe-prefix-bindings=). It will also save the - prefix that you just entered. So =C-x C-h C-h C-x= will popup the which-key - buffer for the prefix =C-x= change the page twice and then execute the command - bound to =C-x C-x=. -- =C-h= will also now popup the which-key buffer to the first page if it is - pressed before =which-key-idle-delay= takes effect. This means you can set a - long idle delay if you like and just use =C-h= when you want to see - =which-key=. -- Note that this behavior is easily disabled, and you have the ability to choose - another binding of course. +- The new option =which-key-prevent-C-h-from-cycling=, which is =nil= by default + allows one to take advantage of using =C-h= for paging as well as the default + Emacs behavior of using =C-h= to describe the bindings for the current key + sequence prefix. +- The configuration below will allow you to switch paging using =C-h= until you + reach the last page of keys in the which-key buffer. The next press of =C-h= + will close the which-key buffer and trigger the default Emacs behavior on + =C-h=. + #+BEGIN_SRC Emacs-lisp + (setq which-key-use-C-h-for-paging t + which-key-prevent-C-h-from-cycling t) + #+END_SRC +- 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. + ** 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 @@ -49,37 +43,36 @@ Many of these have been implemented and are described below. ** Table of Contents :TOC@4: - [[#which-key-][which-key ]] - - [[#whats-new][What's new]] - - [[#local-map-face][Local map face]] - - [[#paging][Paging]] - - [[#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]] - - [[#special-features-and-configuration-options][Special Features and Configuration Options]] - - [[#popup-type-options][Popup Type Options]] - - [[#minibuffer][minibuffer]] - - [[#side-window][side window]] - - [[#frame][frame]] - - [[#custom][custom]] - - [[#custom-string-replacement-options][Custom String Replacement Options]] - - [[#key-based-replacement]["Key-Based" replacement]] - - [[#key-and-description-replacement][Key and Description replacement]] - - [[#sorting-options][Sorting Options]] - - [[#paging-options][Paging Options]] - - [[#method-1-default-using-c-h-or-help-char][Method 1 (default): Using C-h (or =help-char=)]] - - [[#method-2-bind-your-own-keys][Method 2: Bind your own keys]] - - [[#face-customization-options][Face Customization Options]] - - [[#other-options][Other Options]] - - [[#more-examples][More Examples]] - - [[#nice-display-with-split-frame][Nice Display with Split Frame]] - - [[#status][Status]] - - [[#thanks][Thanks]] + - [[#whats-new][What's new]] + - [[#paging][Paging]] + - [[#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]] + - [[#special-features-and-configuration-options][Special Features and Configuration Options]] + - [[#popup-type-options][Popup Type Options]] + - [[#minibuffer][minibuffer]] + - [[#side-window][side window]] + - [[#frame][frame]] + - [[#custom][custom]] + - [[#custom-string-replacement-options][Custom String Replacement Options]] + - [[#key-based-replacement]["Key-Based" replacement]] + - [[#key-and-description-replacement][Key and Description replacement]] + - [[#sorting-options][Sorting Options]] + - [[#paging-options][Paging Options]] + - [[#method-1-default-using-c-h-or-help-char][Method 1 (default): Using C-h (or =help-char=)]] + - [[#method-2-bind-your-own-keys][Method 2: Bind your own keys]] + - [[#face-customization-options][Face Customization Options]] + - [[#other-options][Other Options]] + - [[#more-examples][More Examples]] + - [[#nice-display-with-split-frame][Nice Display with Split Frame]] + - [[#status][Status]] + - [[#thanks][Thanks]] ** Install *** MELPA @@ -90,7 +83,7 @@ minor mode of course. *** Manually Add which-key.el to your =load-path= and require. Something like -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp (add-to-list 'load-path "path/to/which-key.el") (require 'which-key) (which-key-mode) @@ -117,12 +110,12 @@ screenshots. There are other substitution abilities included, which are quite flexible (ability to use regexp for example). This makes which-key very customizable. -This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacemacs]]. +This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacEmacs]]. *** Side Window Bottom Option Popup side window on bottom. This is the current default. To restore this setup use -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp (which-key-setup-side-window-bottom) #+END_SRC @@ -131,7 +124,7 @@ Popup side window on bottom. This is the current default. To restore this setup *** Side Window Right Option Popup side window on right. For defaults use -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp (which-key-setup-side-window-right) #+END_SRC @@ -149,14 +142,14 @@ 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 +#+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 +#+BEGIN_SRC Emacs-lisp (which-key-setup-minibuffer) #+END_SRC @@ -173,16 +166,16 @@ 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 +#+BEGIN_SRC Emacs-lisp (setq which-key-popup-type 'minibuffer) #+END_SRC Show keys in the minibuffer. **** side window -#+BEGIN_SRC emacs-lisp +#+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 +#+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 @@ -201,13 +194,13 @@ Show keys in a side window. This popup type has further options: #+END_SRC **** frame -#+BEGIN_SRC emacs-lisp +#+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 +#+BEGIN_SRC Emacs-lisp ;; max width of which-key frame: number of columns (an integer) (setq which-key-frame-max-width 60) @@ -224,7 +217,7 @@ variables for more information, but here is a working example (this is the current implementation of side-window bottom). -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp (setq which-key-popup-type 'custom) (defun which-key-custom-popup-max-dimensions-function (ignore) (cons @@ -255,7 +248,7 @@ The relevant variable is the awkwardly named =which-key-key-based-description-replacement-alist=. In this alist you can have cons cells of two types. An example of the first type is -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp ("C-x C-f" . "find files") #+END_SRC @@ -264,7 +257,7 @@ to replace. 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 +#+BEGIN_SRC Emacs-lisp (org-mode . (("C-c C-c" . "Org C-c C-c") ("C-c C-a" . "Org Attach")) #+END_SRC @@ -284,7 +277,7 @@ descriptions directly. The relevant variables are =which-key-key-replacement-alist= and =which-key-description-replacement-alist=. Here's an example of one of the default key replacements -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp ("<\\([[:alnum:]-]+\\)>" . "\\1") #+END_SRC @@ -292,14 +285,14 @@ The =car= takes a string which may use Emacs regexp and the =cdr= takes a string with the replacement text. As shown, you can specify a sub-expression of the match. The replacements do not need to use regexp and can be as simple as -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp ("left" . "lft") #+END_SRC You can add this element to the key list with (there are no helper functions for these alists) -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp (add-to-list 'which-key-key-replacement-alist '("left" . "lft")) #+END_SRC @@ -312,7 +305,7 @@ their order are You can control the order by setting this variable. -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp (setq which-key-sort-order 'which-key-key-order) ;; or (setq which-key-sort-order 'which-key-description-order) #+END_SRC @@ -331,7 +324,7 @@ 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 +#+BEGIN_SRC Emacs-lisp (setq which-key-use-C-h-for-paging nil) #+END_SRC to disable the behavior (this will only take effect after toggling @@ -345,18 +338,35 @@ keystroke can complete the command. As a bonus you can type =C-x C-h= and the which-key buffer will pop up immediately (i.e., before =which-key-idle-delay= kicks in). +The option =which-key-prevent-C-h-from-cycling=, which is =nil= by default +allows one to take advantage of using =C-h= for paging as well as the default +Emacs behavior of using =C-h= to describe the bindings for the current key +sequence prefix. + +The configuration below will allow you to switch paging using =C-h= until you +reach the last page of keys in the which-key buffer. The next press of =C-h= +will close the which-key buffer and trigger the default Emacs behavior on =C-h=. +#+BEGIN_SRC Emacs-lisp +(setq which-key-use-C-h-for-paging t + which-key-prevent-C-h-from-cycling t) +#+END_SRC +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 == to the relevant command. -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp (define-key which-key-mode-map (kbd "C-x ") 'which-key-show-next-page) #+END_SRC This is completely equivalent to -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp (setq which-key-paging-prefixes '("C-x")) (setq which-key-paging-key "") #+END_SRC @@ -382,13 +392,13 @@ 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 +#+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 +#+BEGIN_SRC Emacs-lisp (set-face-attribute 'which-key-local-map-description-face nil :weight 'bold) #+END_SRC @@ -399,7 +409,7 @@ your liking. The options below are also available through customize. Their defaults are shown. -#+BEGIN_SRC emacs-lisp +#+BEGIN_SRC Emacs-lisp ;; Set the time delay (in seconds) for the which-key popup to appear. (setq which-key-idle-delay 1.0) commit fa202a53ff3defcb9aff1bfffec9a599745d399f Author: Justin Burkett Date: Tue Sep 1 13:00:51 2015 -0400 Fix compiler warning diff --git a/which-key.el b/which-key.el index 325e1438e0a..51e03c64826 100644 --- a/which-key.el +++ b/which-key.el @@ -1158,8 +1158,6 @@ Will force an update if called before `which-key--update'." (next-event-if-not-showing (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence keysbl))) - (n-pages - (plist-get which-key--pages-plist :n-pages)) (next-page (if which-key--current-page-n (1+ which-key--current-page-n) 0))) (cond commit aefca12690013abcf2fa443ce9d5ca18c9cd25ae Author: Justin Burkett Date: Tue Sep 1 10:53:04 2015 -0400 Fix implementation of prevent-C-h-from-cycling diff --git a/which-key.el b/which-key.el index 8bd40e47b73..325e1438e0a 100644 --- a/which-key.el +++ b/which-key.el @@ -332,6 +332,8 @@ Used when `which-key-popup-type' is frame.") (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.") @@ -572,7 +574,8 @@ total height." (defun which-key--hide-popup () "This function is called to hide the which-key buffer." (unless (eq real-this-command 'which-key-show-next-page) - (setq which-key--current-page-n nil) + (setq which-key--current-page-n nil + which-key--on-last-page nil) (cl-case which-key-popup-type ;; Not necessary to hide minibuffer ;; (minibuffer (which-key--hide-buffer-minibuffer)) @@ -580,6 +583,14 @@ total height." (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-buffer-side-window () "Hide which-key buffer when side-window popup is used." (when (buffer-live-p which-key--buffer) @@ -1046,8 +1057,9 @@ area." (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) + (setq page-n (mod n n-pages) + which-key--current-page-n page-n) + (when (= n-pages (1+ n)) (setq which-key--on-last-page t)) (let* ((page (nth page-n (plist-get which-key--pages-plist :pages))) (height (plist-get which-key--pages-plist :page-height)) (width (nth page-n (plist-get which-key--pages-plist :page-widths))) @@ -1072,14 +1084,16 @@ enough space based on your settings and frame size." prefix-keys) (string-width status-left)))) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) (status-left (s-pad-right first-col-width " " status-left)) - (nxt-pg-hint (cond ((and (< 1 n-pages) (= (1+ page-n) n-pages) + (nxt-pg-hint (cond ((and which-key--on-last-page which-key-prevent-C-h-from-cycling which-key-use-C-h-for-paging) - (propertize "[C-h desc-binds]" + (propertize (format "[C-h or ?%shelp]" + which-key-separator) 'face 'which-key-note-face)) ((and (< 1 n-pages) which-key-use-C-h-for-paging) - (propertize (format "[C-h pg %s]" + (propertize (format "[C-h or ?%spg %s]" + which-key-separator (1+ (mod (1+ page-n) n-pages))) 'face 'which-key-note-face)) ((and (< 1 n-pages) @@ -1126,35 +1140,43 @@ enough space based on your settings and frame size." prefix-keys) "Show the next page of keys. Will force an update if called before `which-key--update'." (interactive) - (if which-key--current-page-n - ;; triggered after timer shows buffer - (let ((n-pages (plist-get which-key--pages-plist :n-pages)) - (next-page (1+ which-key--current-page-n))) - (if (and which-key-prevent-C-h-from-cycling - which-key-use-C-h-for-paging - (>= next-page n-pages)) - (progn - (which-key--hide-popup) - (describe-prefix-bindings)) - (which-key--stop-timer) - (setq unread-command-events - ;; forces event into current key sequence - (mapcar (lambda (ev) (cons t ev)) - (listify-key-sequence which-key--current-prefix))) - (if which-key--last-try-2-loc - (let ((which-key-side-window-location which-key--last-try-2-loc)) - (which-key--show-page next-page)) - (which-key--show-page next-page)) - (which-key--start-paging-timer))) - ;; triggered before buffer is showing - (let* ((keysbl (vconcat (butlast (append (this-single-command-keys) nil))))) - (which-key--stop-timer) - (setq unread-command-events + (if (and which-key--current-page-n + which-key--on-last-page + which-key-use-C-h-for-paging + which-key-prevent-C-h-from-cycling) + (progn + (which-key--hide-popup-ignore-command) + (which-key--stop-timer) + (funcall which-key--prefix-help-cmd-backup) + (which-key--start-timer)) + (let* ((next-event-if-showing ;; forces event into current key sequence + (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence which-key--current-prefix))) + (keysbl + (vconcat (butlast (append (this-single-command-keys) nil)))) + (next-event-if-not-showing (mapcar (lambda (ev) (cons t ev)) (listify-key-sequence keysbl))) - (which-key--create-buffer-and-show keysbl) - (which-key--start-timer)))) + (n-pages + (plist-get which-key--pages-plist :n-pages)) + (next-page + (if which-key--current-page-n (1+ which-key--current-page-n) 0))) + (cond + ;; buffer not showing + ((null which-key--current-page-n) + (which-key--stop-timer) + (setq unread-command-events next-event-if-not-showing) + (which-key--create-buffer-and-show keysbl) + (which-key--start-timer)) + (t + (which-key--stop-timer) + (setq unread-command-events next-event-if-showing) + (if which-key--last-try-2-loc + (let ((which-key-side-window-location which-key--last-try-2-loc)) + (which-key--show-page next-page)) + (which-key--show-page next-page)) + (which-key--start-paging-timer)))))) ;; (defun which-key-show-first-page () ;; "Show the first page of keys." @@ -1241,7 +1263,8 @@ Finally, show the buffer." (and (< 0 (length (this-single-command-keys))) (not (equal which-key--current-prefix (this-single-command-keys))))) - (setq which-key--current-page-n nil) + (setq which-key--current-page-n nil + which-key--on-last-page nil) (cancel-timer which-key--paging-timer) (which-key--start-timer)))))) commit 353ab03968bb3a706e7eccfa4e8e9a45e33fb5a0 Author: Justin Burkett Date: Tue Sep 1 00:16:19 2015 -0400 Add experimental support for using descbinds Adds a new variable which is disabled by default, called which-key-prevent-C-h-from-cycling. If both this new variable and which-key-use-C-h-for-paging are t, then C-h will page through to the last page, but then drop into the default emacs behavior of calling describe-prefix-bindings instead of cycling to page 1 again. diff --git a/which-key.el b/which-key.el index 09ab2e886c4..8bd40e47b73 100644 --- a/which-key.el +++ b/which-key.el @@ -229,6 +229,16 @@ prefixes in `which-key-paging-prefixes'" :group 'which-key :type 'boolean) +(defcustom which-key-prevent-C-h-from-cycling nil + "Experimental: When using C-h for paging, which-key overrides + the default behavior of calling `describe-prefix-bindings'. + Setting this variable to t makes it so that when on the last + page, pressing C-h calls the default function instead of + cycling pages. If you want which-key to cycle, set this to + nil." + :group 'which-key + :type 'boolean) + ;; Faces (defface which-key-key-face '((t . (:inherit font-lock-constant-face))) @@ -343,9 +353,9 @@ used.") (progn (setq which-key--echo-keystrokes-backup echo-keystrokes) (unless which-key--is-setup (which-key--setup)) + (setq which-key--prefix-help-cmd-backup prefix-help-command) (when which-key-use-C-h-for-paging - (setq which-key--prefix-help-cmd-backup prefix-help-command - prefix-help-command #'which-key-show-next-page)) + (setq prefix-help-command #'which-key-show-next-page)) (when which-key-show-remaining-keys (add-hook 'pre-command-hook #'which-key--lighter-restore)) (add-hook 'pre-command-hook #'which-key--hide-popup) @@ -353,8 +363,7 @@ used.") (add-hook 'focus-in-hook #'which-key--start-timer) (which-key--start-timer)) (setq echo-keystrokes which-key--echo-keystrokes-backup) - (when which-key-use-C-h-for-paging - (setq prefix-help-command 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) @@ -1063,7 +1072,12 @@ enough space based on your settings and frame size." prefix-keys) (string-width status-left)))) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) (status-left (s-pad-right first-col-width " " status-left)) - (nxt-pg-hint (cond ((and (< 1 n-pages) + (nxt-pg-hint (cond ((and (< 1 n-pages) (= (1+ page-n) n-pages) + which-key-prevent-C-h-from-cycling + which-key-use-C-h-for-paging) + (propertize "[C-h desc-binds]" + 'face 'which-key-note-face)) + ((and (< 1 n-pages) which-key-use-C-h-for-paging) (propertize (format "[C-h pg %s]" (1+ (mod (1+ page-n) n-pages))) @@ -1114,17 +1128,24 @@ Will force an update if called before `which-key--update'." (interactive) (if which-key--current-page-n ;; triggered after timer shows buffer - (let ((next-page (1+ which-key--current-page-n))) - (which-key--stop-timer) - (setq unread-command-events - ;; forces event into current key sequence - (mapcar (lambda (ev) (cons t ev)) - (listify-key-sequence which-key--current-prefix))) - (if which-key--last-try-2-loc - (let ((which-key-side-window-location which-key--last-try-2-loc)) - (which-key--show-page next-page)) - (which-key--show-page next-page)) - (which-key--start-paging-timer)) + (let ((n-pages (plist-get which-key--pages-plist :n-pages)) + (next-page (1+ which-key--current-page-n))) + (if (and which-key-prevent-C-h-from-cycling + which-key-use-C-h-for-paging + (>= next-page n-pages)) + (progn + (which-key--hide-popup) + (describe-prefix-bindings)) + (which-key--stop-timer) + (setq unread-command-events + ;; forces event into current key sequence + (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence which-key--current-prefix))) + (if which-key--last-try-2-loc + (let ((which-key-side-window-location which-key--last-try-2-loc)) + (which-key--show-page next-page)) + (which-key--show-page next-page)) + (which-key--start-paging-timer))) ;; triggered before buffer is showing (let* ((keysbl (vconcat (butlast (append (this-single-command-keys) nil))))) (which-key--stop-timer) commit a251b4e4c53d61f7e8627c01b463e9025dd25d52 Author: Justin Burkett Date: Thu Aug 27 08:43:55 2015 -0400 Fix echo-keystrokes backup diff --git a/which-key.el b/which-key.el index 024d155301d..09ab2e886c4 100644 --- a/which-key.el +++ b/which-key.el @@ -341,6 +341,7 @@ used.") map) (if which-key-mode (progn + (setq which-key--echo-keystrokes-backup echo-keystrokes) (unless which-key--is-setup (which-key--setup)) (when which-key-use-C-h-for-paging (setq which-key--prefix-help-cmd-backup prefix-help-command @@ -382,16 +383,15 @@ set too high) and setup which-key buffer." (defun which-key--setup-echo-keystrokes () "Reduce `echo-keystrokes' if necessary (it will interfer if it's set too high)." - (when (and echo-keystrokes - (> (abs (- echo-keystrokes which-key-echo-keystrokes)) 0.000001)) - (setq which-key--echo-keystrokes-backup echo-keystrokes) - (if (> which-key-idle-delay which-key-echo-keystrokes) - (setq echo-keystrokes which-key-echo-keystrokes) - (setq which-key-echo-keystrokes - (min echo-keystrokes (/ (float which-key-idle-delay) 4)) - echo-keystrokes which-key-echo-keystrokes)) - (message "which-key: echo-keystrokes changed from %s to %s" - which-key--echo-keystrokes-backup echo-keystrokes))) + (let ((previous echo-keystrokes)) + (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)) + (message "which-key: echo-keystrokes changed from %s to %s" + previous echo-keystrokes)))) ;; Default configuration functions for use by users. Should be the "best" ;; configurations commit 5eee7e8228f95c9495c4643cdda0bc839c8a3fa5 Author: Justin Burkett Date: Thu Aug 27 08:37:41 2015 -0400 Fix which-key-echo-keystrokes docstring diff --git a/which-key.el b/which-key.el index 4ecd4d30811..024d155301d 100644 --- a/which-key.el +++ b/which-key.el @@ -54,9 +54,10 @@ (defcustom which-key-echo-keystrokes 0 "Value to use for `echo-keystrokes'. -This only applies when `which-key-popup-type' is minibuffer. It -needs to be less than `which-key-idle-delay' or else the echo -will erase the which-key popup." +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) commit 54fd3bbb557e79e1a6cb36a4b1c5003f747a19e5 Author: Justin Burkett Date: Sun Aug 16 18:19:30 2015 -0400 Add helper function for prefix titles diff --git a/which-key.el b/which-key.el index 444ec11ae81..4ecd4d30811 100644 --- a/which-key.el +++ b/which-key.el @@ -478,6 +478,19 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) +;;;###autoload +(defun which-key-add-prefix-title (key-seq-str name &optional force) + "Add title for KEY-SEQ-STR given by TITLE. +FORCE, if non-nil, will add the new title even if one already +exists. KEY-SEQ-STR should be a key sequence string suitable for +`kbd' and NAME should be a string." + (interactive) + (let ((key-seq-lst (listify-key-sequence (kbd key-seq-str)))) + (if (and (null force) + (assoc key-seq-lst which-key-prefix-title-alist)) + (message "which-key: Prefix title not added. A title exists for this prefix.") + (push (cons key-seq-lst name) which-key-prefix-title-alist)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for computing window sizes commit 64083cee087463c1aab4c487cf2044560615656a Author: Justin Burkett Date: Sat Aug 15 21:10:49 2015 -0400 One more change to format of prefix-title-alist diff --git a/which-key.el b/which-key.el index c1c1793a058..444ec11ae81 100644 --- a/which-key.el +++ b/which-key.el @@ -120,10 +120,11 @@ emacs-lisp-mode." (defcustom which-key-prefix-title-alist '() "An alist with elements of the form (key-sequence . prefix-title). -key-sequence is a sequence of the sort produced by `kbd'. -prefix-title is a both string. The title is displayed alongside -the actual current key sequence when `which-key-show-prefix' is -set to either top or echo." +key-sequence is a sequence of the sort produced by applying `kbd' +then `listify-key-sequence' to create a canonical version of the +key sequence. prefix-title is a string. The title is displayed +alongside the actual current key sequence when +`which-key-show-prefix' is set to either top or echo." :group 'which-key :type '(alist :key-type string :value-type string)) @@ -1033,10 +1034,10 @@ enough space based on your settings and frame size." prefix-keys) (dash-w-face (propertize "-" 'face 'which-key-key-face)) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) - (status-top (when (assoc which-key--current-prefix + (status-top (when (assoc (listify-key-sequence which-key--current-prefix) which-key-prefix-title-alist) (propertize - (cdr (assoc which-key--current-prefix + (cdr (assoc (listify-key-sequence which-key--current-prefix) which-key-prefix-title-alist)) 'face 'which-key-note-face))) (status-top (concat status-top commit 5e1d53000a9777fb68904222ea42800006caac0c Author: Justin Burkett Date: Sat Aug 15 20:26:14 2015 -0400 Switch prefix-titles to key-seq as key diff --git a/which-key.el b/which-key.el index 9a5b42e0d3e..c1c1793a058 100644 --- a/which-key.el +++ b/which-key.el @@ -119,11 +119,11 @@ emacs-lisp-mode." :group 'which-key) (defcustom which-key-prefix-title-alist '() - "An alist with elements f the form (key-sequence . prefix-title). -key-sequence and prefix-title are both strings. key-sequence is a -string suitable for calling the `kbd' function on. The title is -displayed alongside the actual current key sequence when -`which-key-show-prefix' is set to either top or echo." + "An alist with elements of the form (key-sequence . prefix-title). +key-sequence is a sequence of the sort produced by `kbd'. +prefix-title is a both string. The title is displayed alongside +the actual current key sequence when `which-key-show-prefix' is +set to either top or echo." :group 'which-key :type '(alist :key-type string :value-type string)) @@ -1033,9 +1033,11 @@ enough space based on your settings and frame size." prefix-keys) (dash-w-face (propertize "-" 'face 'which-key-key-face)) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) - (status-top (when (assoc prefix-keys which-key-prefix-title-alist) + (status-top (when (assoc which-key--current-prefix + which-key-prefix-title-alist) (propertize - (cdr (assoc prefix-keys which-key-prefix-title-alist)) + (cdr (assoc which-key--current-prefix + which-key-prefix-title-alist)) 'face 'which-key-note-face))) (status-top (concat status-top (when (< 1 n-pages) commit 14892bbf5696de4f766ec792e0778f352dad4ac6 Author: Justin Burkett Date: Sat Aug 15 13:03:09 2015 -0400 Add support for "prefix titles". See #58 diff --git a/which-key.el b/which-key.el index 1da7bf85aad..9a5b42e0d3e 100644 --- a/which-key.el +++ b/which-key.el @@ -118,6 +118,15 @@ same way using the alist matched when `major-mode' is emacs-lisp-mode." :group 'which-key) +(defcustom which-key-prefix-title-alist '() + "An alist with elements f the form (key-sequence . prefix-title). +key-sequence and prefix-title are both strings. key-sequence is a +string suitable for calling the `kbd' function on. The title is +displayed alongside the actual current key sequence when +`which-key-show-prefix' is set to either top or echo." + :group 'which-key + :type '(alist :key-type string :value-type string)) + (defcustom which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") "These keys will automatically be truncated to one character and have `which-key-special-key-face' applied to them." @@ -1024,9 +1033,15 @@ enough space based on your settings and frame size." prefix-keys) (dash-w-face (propertize "-" 'face 'which-key-key-face)) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) - (status-top (when (< 1 n-pages) - (propertize (format "(%s of %s)" (1+ page-n) n-pages) - 'face 'which-key-note-face))) + (status-top (when (assoc prefix-keys which-key-prefix-title-alist) + (propertize + (cdr (assoc prefix-keys which-key-prefix-title-alist)) + 'face 'which-key-note-face))) + (status-top (concat status-top + (when (< 1 n-pages) + (propertize (format " (%s of %s)" + (1+ page-n) n-pages) + 'face 'which-key-note-face)))) (first-col-width (+ 2 (max (string-width prefix-w-face) (string-width status-left)))) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) @@ -1062,10 +1077,10 @@ enough space based on your settings and frame size." prefix-keys) new-end (concat "\n" (s-repeat first-col-width " ")) page (concat first (mapconcat #'identity (cdr lines) new-end))))) ((eq which-key-show-prefix 'top) - (setq page (concat prefix-w-face dash-w-face " " + (setq page (concat prefix-w-face dash-w-face " " status-top " " nxt-pg-hint "\n" page))) ((eq which-key-show-prefix 'echo) - (which-key--echo (concat prefix-w-face dash-w-face " " + (which-key--echo (concat prefix-w-face dash-w-face " " status-top " " nxt-pg-hint)))) (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) commit cb2e4a92f9d83b785dd0071c448ea4d59d8117c7 Author: Justin Burkett Date: Mon Aug 10 11:05:04 2015 -0400 show-remaining-keys cleanup diff --git a/which-key.el b/which-key.el index 79f51c576a2..1da7bf85aad 100644 --- a/which-key.el +++ b/which-key.el @@ -334,16 +334,18 @@ used.") (when which-key-use-C-h-for-paging (setq which-key--prefix-help-cmd-backup prefix-help-command prefix-help-command #'which-key-show-next-page)) + (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 'pre-command-hook #'which-key--lighter-restore) (add-hook 'focus-out-hook #'which-key--stop-timer) (add-hook 'focus-in-hook #'which-key--start-timer) (which-key--start-timer)) (setq echo-keystrokes which-key--echo-keystrokes-backup) (when which-key-use-C-h-for-paging (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 'pre-command-hook #'which-key--lighter-restore) (remove-hook 'focus-out-hook #'which-key--stop-timer) (remove-hook 'focus-in-hook #'which-key--start-timer) (which-key--stop-timer))) @@ -985,6 +987,7 @@ is the width of the live window." (setq which-key--lighter-backup (cadr (assq 'which-key-mode minor-mode-alist))) (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 commit 8e4602ad131946e6869c55f601894d142358a8f2 Author: Justin Burkett Date: Mon Aug 10 09:09:59 2015 -0400 Add missing save-match-data call diff --git a/which-key.el b/which-key.el index 81873eb486c..79f51c576a2 100644 --- a/which-key.el +++ b/which-key.el @@ -868,17 +868,18 @@ BUFFER that follow the key sequence KEY-SEQ." (let ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) (buffer (current-buffer)) key-match desc-match unformatted) - (with-temp-buffer - (describe-buffer-bindings buffer which-key--current-prefix) - (goto-char (point-max)) ; want to put last keys in first - (while (re-search-backward - (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" - key-str-qt) - nil t) - (setq key-match (match-string 1) - desc-match (match-string 2)) - (cl-pushnew (cons key-match desc-match) unformatted - :test (lambda (x y) (string-equal (car x) (car y)))))) + (save-match-data + (with-temp-buffer + (describe-buffer-bindings buffer which-key--current-prefix) + (goto-char (point-max)) ; want to put last keys in first + (while (re-search-backward + (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" + key-str-qt) + nil t) + (setq key-match (match-string 1) + desc-match (match-string 2)) + (cl-pushnew (cons key-match desc-match) unformatted + :test (lambda (x y) (string-equal (car x) (car y))))))) (when which-key-sort-order (setq unformatted (sort unformatted (lambda (a b) (funcall which-key-sort-order a b))))) commit 833d17cf1e4c7382845fa7a29c250cb5e2791b90 Author: Justin Burkett Date: Mon Aug 3 15:11:46 2015 -0400 Tweak partition-columns diff --git a/which-key.el b/which-key.el index 6ec03c22ecf..81873eb486c 100644 --- a/which-key.el +++ b/which-key.el @@ -923,23 +923,26 @@ Returns a plist that holds the page strings, as well as metadata." (page-width 0) (n-pages 0) (n-keys 0) page-cols pages page-widths keys/page col) (if (> (apply #'max (mapcar #'car cols-w-widths)) avl-width) - ;; give up if any columns don't fit + ;; 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 - (when (not (<= (+ (caar cols-w-widths) page-width) avl-width)) - (error "which-key: error in partition-columns")) + ;; start new page + (cl-incf n-pages) + (setq col (pop cols-w-widths) + page-cols (list (cdr col)) + page-width (car col) + n-keys (length (cdr col))) + ;; add additional columns as long as they fit (while (and cols-w-widths (<= (+ (caar cols-w-widths) page-width) avl-width)) - (setq col (pop cols-w-widths) - page-width (+ page-width (car col)) - n-keys (+ (length (cdr col)) n-keys)) - (push (cdr col) page-cols)) + (setq col (pop cols-w-widths)) + (push (cdr col) page-cols) + (cl-incf page-width (car col)) + (cl-incf n-keys (length (cdr col)))) (push (which-key--join-columns page-cols) pages) (push n-keys keys/page) - (push page-width page-widths) - (setq n-pages (1+ n-pages) - n-keys 0 page-cols '() page-width 0)) + (push page-width page-widths)) (list :pages (reverse pages) :page-height avl-lines :page-widths (reverse page-widths) :keys/page (reverse keys/page) :n-pages n-pages commit 90e54815b537d2ddc56a3b5c7f19b21a9e0900ec Author: Justin Burkett Date: Mon Aug 3 14:54:20 2015 -0400 Fix ref to free var diff --git a/which-key.el b/which-key.el index cb68ec06af5..6ec03c22ecf 100644 --- a/which-key.el +++ b/which-key.el @@ -921,7 +921,7 @@ Returns a plist that holds the page strings, as well as metadata." (let ((cols-w-widths (mapcar #'which-key--pad-column (-partition-all avl-lines keys))) (page-width 0) (n-pages 0) (n-keys 0) - page-cols pages page-widths keys/page) + page-cols pages page-widths keys/page col) (if (> (apply #'max (mapcar #'car cols-w-widths)) avl-width) ;; give up if any columns don't fit (list :pages nil :page-height 0 :page-widths '(0) commit bfe1e5c9b553736dea735fbce6dd2f64aca85172 Author: Justin Burkett Date: Mon Aug 3 13:46:20 2015 -0400 Replace ?? with lambda by default diff --git a/which-key.el b/which-key.el index 321baf0a95d..cb68ec06af5 100644 --- a/which-key.el +++ b/which-key.el @@ -96,7 +96,8 @@ in the first example." :type '(alist :key-type regexp :value-type string)) (defcustom which-key-description-replacement-alist - '(("Prefix Command" . "prefix") ("which-key-show-next-page" . "wk next pg")) + '(("Prefix Command" . "prefix") ("which-key-show-next-page" . "wk next pg") + ("\\`\\?\\?\\'" . "lambda")) "See `which-key-key-replacement-alist'. This is a list of lists for replacing descriptions." :group 'which-key commit af9e3425ecf3ec2b1ecc3446c8262d53f4f29ec0 Author: Justin Burkett Date: Mon Aug 3 11:26:56 2015 -0400 Clean-up partition-columns implementation diff --git a/which-key.el b/which-key.el index f992a5435d8..321baf0a95d 100644 --- a/which-key.el +++ b/which-key.el @@ -921,32 +921,28 @@ Returns a plist that holds the page strings, as well as metadata." (-partition-all avl-lines keys))) (page-width 0) (n-pages 0) (n-keys 0) page-cols pages page-widths keys/page) - (if (> (car (car cols-w-widths)) avl-width) - ;; give up if first column doesn't fit + (if (> (apply #'max (mapcar #'car cols-w-widths)) avl-width) + ;; give up if any columns don't fit (list :pages nil :page-height 0 :page-widths '(0) :keys/page '(0) :n-pages 0 :tot-keys 0) - (dolist (col cols-w-widths) - (if (<= (+ (car col) page-width) avl-width) - (progn (push (cdr col) page-cols) - (setq page-width (+ page-width (car col)) - n-keys (+ (length (cdr col)) n-keys))) - (when (> (length page-cols) 0) - (push (which-key--join-columns page-cols) pages) - (push n-keys keys/page) - (push page-width page-widths) - (setq n-pages (1+ n-pages) - n-keys (length (cdr col)) - page-cols (list (cdr col)) - page-width (car col))))) - (when (> (length page-cols) 0) + (while cols-w-widths + (when (not (<= (+ (caar cols-w-widths) page-width) avl-width)) + (error "which-key: error in partition-columns")) + (while (and cols-w-widths + (<= (+ (caar cols-w-widths) page-width) avl-width)) + (setq col (pop cols-w-widths) + page-width (+ page-width (car col)) + n-keys (+ (length (cdr col)) n-keys)) + (push (cdr col) page-cols)) (push (which-key--join-columns page-cols) pages) (push n-keys keys/page) (push page-width page-widths) - (setq n-pages (1+ n-pages))) + (setq n-pages (1+ n-pages) + n-keys 0 page-cols '() page-width 0)) (list :pages (reverse pages) :page-height avl-lines :page-widths (reverse page-widths) :keys/page (reverse keys/page) :n-pages n-pages - :tot-keys (cl-reduce '+ keys/page :initial-value 0))))) + :tot-keys (apply #'+ keys/page))))) (defun which-key--create-pages (keys sel-win-width) "Create page strings using `which-key--partition-columns'. commit 3effbaf08027f8fd88f9e92d22e2f7f359491e7e Author: Justin Burkett Date: Sun Aug 2 19:33:24 2015 -0400 Add README intro to commentary section. diff --git a/which-key.el b/which-key.el index a1bab6ed629..f992a5435d8 100644 --- a/which-key.el +++ b/which-key.el @@ -23,8 +23,18 @@ ;;; Commentary: -;; This is a rewrite of guide-key https://github.com/kai2nenobu/guide-key. See -;; https://github.com/justbur/emacs-which-key for more information. +;; 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 along with information about additional features can +;; be found at https://github.com/justbur/emacs-which-key. +;; +;; which-key started as a rewrite of guide-key +;; (https://github.com/kai2nenobu/guide-key), but the feature sets have since +;; diverged. ;;; Code: commit 91f7470a7c3edc91521089ee07b166b94e280543 Author: Justin Burkett Date: Sun Aug 2 19:27:23 2015 -0400 Bump version diff --git a/which-key.el b/which-key.el index a07f5e2c3bd..a1bab6ed629 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.4 +;; Version: 0.5.1 ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) commit 32c57075a33db05447fc7d1d86b2c798dab35e32 Author: Justin Burkett Date: Sat Aug 1 07:16:29 2015 -0400 Allow for nil local-map. Fixes #57 diff --git a/which-key.el b/which-key.el index 99d101c99c3..a07f5e2c3bd 100644 --- a/which-key.el +++ b/which-key.el @@ -712,6 +712,10 @@ width) in lines and characters respectively." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for retrieving and formatting keys +(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))) + (defun which-key--maybe-replace (string repl-alist &optional literal) "Perform replacements on STRING. REPL-ALIST is an alist where the car of each element is the text @@ -796,7 +800,7 @@ alists. Returns a list (key separator description)." (desc (cdr key-desc-cons)) (group (which-key--group-p desc)) (keys (concat (key-description which-key--current-prefix) " " key)) - (local (eq (lookup-key local-map (kbd keys)) (intern desc))) + (local (eq (which-key--safe-lookup-key local-map (kbd keys)) (intern desc))) (key (which-key--maybe-replace key which-key-key-replacement-alist)) (desc (which-key--maybe-replace @@ -1142,9 +1146,9 @@ Finally, show the buffer." (or (keymapp (key-binding prefix-keys)) ;; Some keymaps are stored here like iso-transl-ctl-x-8-map - (keymapp (lookup-key key-translation-map prefix-keys)) + (keymapp (which-key--safe-lookup-key key-translation-map prefix-keys)) ;; just in case someone uses one of these - (keymapp (lookup-key function-key-map prefix-keys))) + (keymapp (which-key--safe-lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) (which-key--create-buffer-and-show prefix-keys)))) commit d613dfe3959e000e81f87cb68b1a4c049d476540 Author: Justin Burkett Date: Thu Jul 30 16:51:01 2015 -0400 README links working again diff --git a/README.org b/README.org index 500fe440431..d0e15e4328f 100644 --- a/README.org +++ b/README.org @@ -5,12 +5,12 @@ - The face =which-key-local-map-description-face= is now available. This face will be applied to any commands that are found using =(current-local-map)= (commands defined for the major mode are usually here). This allows you to - distinguish between local and global bindings visually. See [[#face-customization][Face Customization]] + distinguish between local and global bindings visually. See [[#face-customization-options][Face Customization]] for more information. *** Paging - Paging is now turned on by default, using any prefix plus =C-h= (this doesn't affect key sequences that start with =C-h= and will not override any key - sequences that end will =C-h=). See the [[paging][Paging Section]] for more details and + sequences that end will =C-h=). See the [[#paging-options][Paging Section]] for more details and for other options on using and/or disabling paging. - This makes which-key function as a replacement for the default behavior of pressing =C-h= after a prefix which shows the key bindings for any prefix @@ -62,19 +62,19 @@ Many of these have been implemented and are described below. - [[#side-window-right-then-bottom][Side Window Right then Bottom]] - [[#minibuffer-option][Minibuffer Option]] - [[#special-features-and-configuration-options][Special Features and Configuration Options]] - - [[#several-popup-types][Several Popup Types]] + - [[#popup-type-options][Popup Type Options]] - [[#minibuffer][minibuffer]] - [[#side-window][side window]] - [[#frame][frame]] - [[#custom][custom]] - - [[#custom-string-replacement][Custom String Replacement]] + - [[#custom-string-replacement-options][Custom String Replacement Options]] - [[#key-based-replacement]["Key-Based" replacement]] - [[#key-and-description-replacement][Key and Description replacement]] - - [[#sorting][Sorting]] - - [[#paging][Paging]] + - [[#sorting-options][Sorting Options]] + - [[#paging-options][Paging Options]] - [[#method-1-default-using-c-h-or-help-char][Method 1 (default): Using C-h (or =help-char=)]] - [[#method-2-bind-your-own-keys][Method 2: Bind your own keys]] - - [[#face-customization][Face Customization]] + - [[#face-customization-options][Face Customization Options]] - [[#other-options][Other Options]] - [[#more-examples][More Examples]] - [[#nice-display-with-split-frame][Nice Display with Split Frame]] @@ -168,7 +168,7 @@ variable =max-mini-window-height=. ** 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=. -*** Several Popup Types +*** 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. @@ -244,7 +244,7 @@ current implementation of side-window bottom). (quit-windows-on which-key--buffer))) #+END_SRC -*** Custom String Replacement +*** 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 @@ -303,7 +303,7 @@ these alists) (add-to-list 'which-key-key-replacement-alist '("left" . "lft")) #+END_SRC -*** Sorting +*** 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 @@ -321,9 +321,7 @@ The only other built-in option at the moment (besides using nil to turn off sorting completely) is =which-key-description-order=, which orders by the key's description based on the usual ordering of strings after applying =downcase=. -*** Paging -<> - +*** 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 @@ -365,7 +363,7 @@ This is completely equivalent to where the latter are provided for convenience if you have a lot of prefixes. -*** Face Customization +*** Face Customization Options The faces that which-key uses are | Face | Applied To | Default Definition | |----------------------------------------+-------------------------------+-------------------------------------------------------------| commit 4b5ade3d49825889f00542846346d2c82ea1fd5e Author: Justin Burkett Date: Thu Jul 30 16:10:15 2015 -0400 Second try to fix links diff --git a/README.org b/README.org index 76aae582082..500fe440431 100644 --- a/README.org +++ b/README.org @@ -5,7 +5,7 @@ - The face =which-key-local-map-description-face= is now available. This face will be applied to any commands that are found using =(current-local-map)= (commands defined for the major mode are usually here). This allows you to - distinguish between local and global bindings visually. See [[Face Customization]] + distinguish between local and global bindings visually. See [[#face-customization][Face Customization]] for more information. *** Paging - Paging is now turned on by default, using any prefix plus =C-h= (this doesn't commit f32bbf0adbd9bab2bdb2e0ddffc1f2c61f712d57 Author: Justin Burkett Date: Thu Jul 30 16:05:26 2015 -0400 Fix a link in readme diff --git a/README.org b/README.org index 650b9f82543..76aae582082 100644 --- a/README.org +++ b/README.org @@ -5,12 +5,12 @@ - The face =which-key-local-map-description-face= is now available. This face will be applied to any commands that are found using =(current-local-map)= (commands defined for the major mode are usually here). This allows you to - distinguish between local and global bindings visually. See [[#faces][Face Customization]] - for more information. + distinguish between local and global bindings visually. See [[Face Customization]] + for more information. *** Paging - Paging is now turned on by default, using any prefix plus =C-h= (this doesn't affect key sequences that start with =C-h= and will not override any key - sequences that end will =C-h=). See the [[#paging][Paging Section]] for more details and + sequences that end will =C-h=). See the [[paging][Paging Section]] for more details and for other options on using and/or disabling paging. - This makes which-key function as a replacement for the default behavior of pressing =C-h= after a prefix which shows the key bindings for any prefix @@ -321,8 +321,8 @@ The only other built-in option at the moment (besides using nil to turn off sorting completely) is =which-key-description-order=, which orders by the key's description based on the usual ordering of strings after applying =downcase=. -#+NAME: paging *** Paging +<> 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 @@ -349,8 +349,6 @@ kicks in). **** Method 2: Bind your own keys - - Essentially, all you need to do for a prefix like =C-x= is the following which will bind == to the relevant command. @@ -367,7 +365,6 @@ This is completely equivalent to where the latter are provided for convenience if you have a lot of prefixes. -#+NAME: faces *** Face Customization The faces that which-key uses are | Face | Applied To | Default Definition | commit 2e7744cc783cd2de58438c12ab9f4e9343582f1f Author: Justin Burkett Date: Thu Jul 30 15:52:21 2015 -0400 Add local-map face to readme diff --git a/README.org b/README.org index 9efa7e2e255..650b9f82543 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,12 @@ * which-key [[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]] ** What's new +*** Local map face +- The face =which-key-local-map-description-face= is now available. This face + will be applied to any commands that are found using =(current-local-map)= + (commands defined for the major mode are usually here). This allows you to + distinguish between local and global bindings visually. See [[#faces][Face Customization]] + for more information. *** Paging - Paging is now turned on by default, using any prefix plus =C-h= (this doesn't affect key sequences that start with =C-h= and will not override any key @@ -44,6 +50,7 @@ Many of these have been implemented and are described below. ** Table of Contents :TOC@4: - [[#which-key-][which-key ]] - [[#whats-new][What's new]] + - [[#local-map-face][Local map face]] - [[#paging][Paging]] - [[#introduction][Introduction]] - [[#install][Install]] @@ -67,6 +74,7 @@ Many of these have been implemented and are described below. - [[#paging][Paging]] - [[#method-1-default-using-c-h-or-help-char][Method 1 (default): Using C-h (or =help-char=)]] - [[#method-2-bind-your-own-keys][Method 2: Bind your own keys]] + - [[#face-customization][Face Customization]] - [[#other-options][Other Options]] - [[#more-examples][More Examples]] - [[#nice-display-with-split-frame][Nice Display with Split Frame]] @@ -341,6 +349,8 @@ kicks in). **** Method 2: Bind your own keys + + Essentially, all you need to do for a prefix like =C-x= is the following which will bind == to the relevant command. @@ -357,6 +367,39 @@ This is completely equivalent to where the latter are provided for convenience if you have a lot of prefixes. +#+NAME: faces +*** Face Customization +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 The options below are also available through customize. Their defaults are shown. commit 1e88120ab59ac4a0875a96f01e3863544ab5a8a8 Author: Justin Burkett Date: Tue Jul 28 22:42:23 2015 -0400 Add local-map face Possible solution for #45. Does not change any default settings. diff --git a/which-key.el b/which-key.el index 3233f4efb4d..99d101c99c3 100644 --- a/which-key.el +++ b/which-key.el @@ -228,6 +228,11 @@ prefixes in `which-key-paging-prefixes'" "Face for the key description when it is a command" :group 'which-key) +(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) + (defface which-key-group-description-face '((t . (:inherit font-lock-keyword-face))) "Face for the key description when it is a group or prefix" @@ -763,7 +768,7 @@ If KEY contains any \"special keys\" defined in (or (string-match-p "^\\(group:\\|Prefix\\)" description) (keymapp (intern description)))) -(defun which-key--propertize-description (description group) +(defun which-key--propertize-description (description group local) "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 @@ -774,29 +779,31 @@ removing a \"group:\" prefix." (desc (if group (concat "+" desc) desc)) (desc (which-key--truncate-description desc))) (propertize desc 'face - (if group - 'which-key-group-description-face - 'which-key-command-description-face)))) + (cond (group 'which-key-group-description-face) + (local 'which-key-local-map-description-face) + (t 'which-key-command-description-face))))) (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))) + (propertize which-key-separator 'face 'which-key-separator-face)) + (local-map (current-local-map))) (mapcar (lambda (key-desc-cons) (let* ((key (car key-desc-cons)) (desc (cdr key-desc-cons)) (group (which-key--group-p desc)) (keys (concat (key-description which-key--current-prefix) " " key)) + (local (eq (lookup-key local-map (kbd keys)) (intern desc))) (key (which-key--maybe-replace key which-key-key-replacement-alist)) (desc (which-key--maybe-replace desc which-key-description-replacement-alist)) (desc (which-key--maybe-replace-key-based desc keys)) (key-w-face (which-key--propertize-key key)) - (desc-w-face (which-key--propertize-description desc group))) + (desc-w-face (which-key--propertize-description desc group local))) (list key-w-face sep-w-face desc-w-face))) unformatted))) @@ -840,10 +847,11 @@ special (SPC,TAB,...) < single char < mod (C-,M-,...) < other." Uses `string-lessp' after applying lowercase." (string-lessp (downcase (cdr alst)) (downcase (cdr blst)))) -(defun which-key--get-formatted-key-bindings (buffer) +(defun which-key--get-formatted-key-bindings () "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." (let ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) + (buffer (current-buffer)) key-match desc-match unformatted) (with-temp-buffer (describe-buffer-bindings buffer which-key--current-prefix) @@ -1111,8 +1119,7 @@ Will force an update if called before `which-key--update'." Finally, show the buffer." (setq which-key--current-prefix prefix-keys which-key--last-try-2-loc nil) - (let ((formatted-keys (which-key--get-formatted-key-bindings - (current-buffer))) + (let ((formatted-keys (which-key--get-formatted-key-bindings)) (prefix-keys-desc (key-description prefix-keys))) (cond ((= (length formatted-keys) 0) (message "%s- which-key: There are no keys to show" prefix-keys-desc)) commit 4d4dc93067d921bf1e6c6d4adc2d55fea13fc4d7 Author: Justin Burkett Date: Tue Jul 28 22:41:35 2015 -0400 README fixes diff --git a/img/which-key-bottom.png b/img/which-key-bottom.png index 386fe1af69d..d7e725b3a22 100644 Binary files a/img/which-key-bottom.png and b/img/which-key-bottom.png differ diff --git a/img/which-key-minibuffer.png b/img/which-key-minibuffer.png index 0b83860f6ba..bb5d00bf26b 100644 Binary files a/img/which-key-minibuffer.png and b/img/which-key-minibuffer.png differ diff --git a/img/which-key-right.png b/img/which-key-right.png index aae2ed07f0a..8af4d682e6b 100644 Binary files a/img/which-key-right.png and b/img/which-key-right.png differ commit 9e5d5fb969367881a64c3dc4f2ab3e56e7ff4c06 Author: Justin Burkett Date: Mon Jul 27 22:41:39 2015 -0400 README typos diff --git a/README.org b/README.org index 67facfdbddb..9efa7e2e255 100644 --- a/README.org +++ b/README.org @@ -19,10 +19,10 @@ - Note that this behavior is easily disabled, and you have the ability to choose another binding of course. ** Introduction -=which-key= is a minor mode for Emacs that displays the keybindings following your currently +=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 keybindings that follow =C-x= (or as many as space allows given your settings). +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 @@ -97,7 +97,7 @@ 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 +your Emacs settings, the size of the current Emacs frame, and the which-key settings, most of which are described below. By default which-key makes substitutions for text all with the aim of saving @@ -138,7 +138,7 @@ width (see =M-x customize-group which-key=). 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 caes if you are using +the Emacs frame changes frequently, which might be the case if you are using a dynamic/tiling window manager. #+BEGIN_SRC emacs-lisp @@ -280,7 +280,7 @@ Here's an example of one of the default key replacements ("<\\([[:alnum:]-]+\\)>" . "\\1") #+END_SRC -The =car= takes a string which may use emacs regexp and the =cdr= takes a string +The =car= takes a string which may use Emacs regexp and the =cdr= takes a string with the replacement text. As shown, you can specify a sub-expression of the match. The replacements do not need to use regexp and can be as simple as @@ -331,10 +331,10 @@ This is the easiest way, and is turned on by default. Use 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 keybindings that apply to a prefix. +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 +Emacs default saves the incomplete prefix that you just entered so that the next keystroke can complete the command. As a bonus you can type =C-x C-h= and the which-key buffer will pop up immediately (i.e., before =which-key-idle-delay= kicks in). @@ -371,8 +371,8 @@ shown. ;; 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 + ;; 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) commit 768ed25eba4295a50410eed6b34b6363ff9c3cc8 Author: Justin Burkett Date: Mon Jul 27 22:34:56 2015 -0400 Reorg README and new pictures diff --git a/README.org b/README.org index 1f8be5751cf..67facfdbddb 100644 --- a/README.org +++ b/README.org @@ -8,9 +8,10 @@ for other options on using and/or disabling paging. - This makes which-key function as a replacement for the default behavior of pressing =C-h= after a prefix which shows the key bindings for any prefix - (this default command is =describe-prefix-bindings=). It will also save the prefix that you just entered. So =C-x C-h C-h C-x= will - popup the which-key buffer for the prefix =C-x= change the page twice and then - execute the command bound to =C-x C-x=. + (this default command is =describe-prefix-bindings=). It will also save the + prefix that you just entered. So =C-x C-h C-h C-x= will popup the which-key + buffer for the prefix =C-x= change the page twice and then execute the command + bound to =C-x C-x=. - =C-h= will also now popup the which-key buffer to the first page if it is pressed before =which-key-idle-delay= takes effect. This means you can set a long idle delay if you like and just use =C-h= when you want to see @@ -49,10 +50,10 @@ Many of these have been implemented and are described below. - [[#melpa][MELPA]] - [[#manually][Manually]] - [[#initial-setup][Initial Setup]] - - [[#minibuffer-option][Minibuffer Option]] - - [[#side-window-right-option][Side Window Right Option]] - [[#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]] - [[#special-features-and-configuration-options][Special Features and Configuration Options]] - [[#several-popup-types][Several Popup Types]] - [[#minibuffer][minibuffer]] @@ -110,17 +111,14 @@ There are other substitution abilities included, which are quite flexible (ability to use regexp for example). This makes which-key very customizable. This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacemacs]]. -*** Minibuffer Option -Take over the minibuffer. For the recommended configuration use +*** 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-minibuffer) +(which-key-setup-side-window-bottom) #+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=. +[[./img/which-key-bottom.png]] *** Side Window Right Option Popup side window on right. For defaults use @@ -136,15 +134,6 @@ width (see =M-x customize-group which-key=). [[./img/which-key-right.png]] -*** 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 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 @@ -156,6 +145,18 @@ a dynamic/tiling window manager. (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=. + ** 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=. diff --git a/img/which-key-bottom.png b/img/which-key-bottom.png index 00d372aef06..386fe1af69d 100644 Binary files a/img/which-key-bottom.png and b/img/which-key-bottom.png differ diff --git a/img/which-key-minibuffer.png b/img/which-key-minibuffer.png index 0ce5263b14d..0b83860f6ba 100644 Binary files a/img/which-key-minibuffer.png and b/img/which-key-minibuffer.png differ diff --git a/img/which-key-right.png b/img/which-key-right.png index 7342863c801..aae2ed07f0a 100644 Binary files a/img/which-key-right.png and b/img/which-key-right.png differ commit a413d7412751da987f76f4d49113915cfc6cebfb Author: Justin Burkett Date: Mon Jul 27 22:24:48 2015 -0400 Minor wording change to readme diff --git a/README.org b/README.org index 472607da282..1f8be5751cf 100644 --- a/README.org +++ b/README.org @@ -8,8 +8,7 @@ for other options on using and/or disabling paging. - This makes which-key function as a replacement for the default behavior of pressing =C-h= after a prefix which shows the key bindings for any prefix - (this default command is =describe-prefix-bindings=). It is better though, - because it saves the prefix that you just entered. So =C-x C-h C-h C-x= will + (this default command is =describe-prefix-bindings=). It will also save the prefix that you just entered. So =C-x C-h C-h C-x= will popup the which-key buffer for the prefix =C-x= change the page twice and then execute the command bound to =C-x C-x=. - =C-h= will also now popup the which-key buffer to the first page if it is commit 6af1756751c440004941265fdd17e2065b3c3ba2 Author: Justin Burkett Date: Mon Jul 27 22:04:40 2015 -0400 Add note to readme diff --git a/README.org b/README.org index fe97841df7d..472607da282 100644 --- a/README.org +++ b/README.org @@ -7,14 +7,17 @@ sequences that end will =C-h=). See the [[#paging][Paging Section]] for more details and for other options on using and/or disabling paging. - This makes which-key function as a replacement for the default behavior of - pressing =C-h= after a prefix which shows the key bindings for any prefix. It - is better though, because it saves the prefix that you just entered. So =C-x - C-h C-h C-x= will popup the which-key buffer for the prefix =C-x= change the - page twice and then execute the command bound to =C-x C-x=. + pressing =C-h= after a prefix which shows the key bindings for any prefix + (this default command is =describe-prefix-bindings=). It is better though, + because it saves the prefix that you just entered. So =C-x C-h C-h C-x= will + popup the which-key buffer for the prefix =C-x= change the page twice and then + execute the command bound to =C-x C-x=. - =C-h= will also now popup the which-key buffer to the first page if it is pressed before =which-key-idle-delay= takes effect. This means you can set a long idle delay if you like and just use =C-h= when you want to see =which-key=. +- Note that this behavior is easily disabled, and you have the ability to choose + another binding of course. ** Introduction =which-key= is a minor mode for Emacs that displays the keybindings following your currently entered incomplete command (a prefix) in a popup. For example, after enabling the minor mode commit 9f56b94677943cd48f5d8555760f68128092f214 Author: Justin Burkett Date: Mon Jul 27 22:00:42 2015 -0400 Revert "Fix some parts of readme" This reverts commit a5413c2b8af110225fabbe64bcad4703c353327c. diff --git a/README.org b/README.org index 3db0bed0bbc..fe97841df7d 100644 --- a/README.org +++ b/README.org @@ -11,6 +11,10 @@ is better though, because it saves the prefix that you just entered. So =C-x C-h C-h C-x= will popup the which-key buffer for the prefix =C-x= change the page twice and then execute the command bound to =C-x C-x=. +- =C-h= will also now popup the which-key buffer to the first page if it is + pressed before =which-key-idle-delay= takes effect. This means you can set a + long idle delay if you like and just use =C-h= when you want to see + =which-key=. ** Introduction =which-key= is a minor mode for Emacs that displays the keybindings following your currently entered incomplete command (a prefix) in a popup. For example, after enabling the minor mode @@ -289,7 +293,6 @@ these alists) #+END_SRC *** Sorting - 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 @@ -329,7 +332,9 @@ behavior of emacs which is to show a list of keybindings 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. +keystroke can complete the command. As a bonus you can type =C-x C-h= and the +which-key buffer will pop up immediately (i.e., before =which-key-idle-delay= +kicks in). **** Method 2: Bind your own keys commit 5bdffa6b082965d5d0970293511ae235d483f7be Author: Justin Burkett Date: Mon Jul 27 21:57:42 2015 -0400 More docstrings diff --git a/which-key.el b/which-key.el index 4570a4a9a13..3233f4efb4d 100644 --- a/which-key.el +++ b/which-key.el @@ -292,8 +292,12 @@ Used when `which-key-popup-type' is frame.") "Internal: Holds lighter backup") (defvar which-key--current-prefix nil "Internal: Holds current prefix") -(defvar which-key--current-page-n nil) -(defvar which-key--last-try-2-loc nil) +(defvar which-key--current-page-n nil + "Internal: Current pages of showing buffer. Nil means no buffer +showing.") +(defvar which-key--last-try-2-loc nil + "Internal: Last location of side-window when two locations +used.") ;;;###autoload (define-minor-mode which-key-mode @@ -797,6 +801,7 @@ alists. Returns a list (key separator description)." unformatted))) (defun which-key--key-description< (a b) + "Sorting function used for `which-key-key-order'." (let* ((aem? (string-equal a "")) (bem? (string-equal b "")) (a1? (= 1 (length a))) @@ -888,6 +893,8 @@ that width." col-keys)))) (defun which-key--partition-columns (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 (-partition-all avl-lines keys))) (page-width 0) (n-pages 0) (n-keys 0) @@ -920,6 +927,10 @@ that width." :tot-keys (cl-reduce '+ keys/page :initial-value 0))))) (defun which-key--create-pages (keys sel-win-width) + "Create page strings using `which-key--partition-columns'. +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 sel-win-width)) (max-lines (car max-dims)) (max-width (cdr max-dims)) @@ -946,11 +957,13 @@ that width." (if found prev-result result))))) (defun which-key--lighter-status (n-shown n-tot) + "Possibly show N-SHOWN keys and N-TOT keys in the mode line." (when which-key-show-remaining-keys (setq which-key--lighter-backup (cadr (assq 'which-key-mode minor-mode-alist))) (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-backup))) @@ -1038,7 +1051,8 @@ enough space based on your settings and frame size." prefix-keys) (which-key--show-popup (cons height width))))))) (defun which-key-show-next-page () - "Show the next page of keys." + "Show the next page of keys. +Will force an update if called before `which-key--update'." (interactive) (if which-key--current-page-n ;; triggered after timer shows buffer @@ -1076,6 +1090,7 @@ enough space based on your settings and frame size." prefix-keys) ;; Update (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)) (setq pages1 (which-key--create-pages keys (window-width)))) commit 754051475afcaa1149ab49b7ac7a71a931572488 Author: Justin Burkett Date: Mon Jul 27 21:47:06 2015 -0400 Allow show-next-page to force update before timer diff --git a/which-key.el b/which-key.el index 262544f234f..4570a4a9a13 100644 --- a/which-key.el +++ b/which-key.el @@ -516,12 +516,14 @@ total height." (defun which-key--hide-popup () "This function is called to hide the which-key buffer." - (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)))) + (unless (eq real-this-command 'which-key-show-next-page) + (setq which-key--current-page-n nil) + (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-buffer-side-window () "Hide which-key buffer when side-window popup is used." @@ -1038,19 +1040,28 @@ enough space based on your settings and frame size." prefix-keys) (defun which-key-show-next-page () "Show the next page of keys." (interactive) - (let ((next-page (if which-key--current-page-n - (1+ which-key--current-page-n) 0))) - (which-key--stop-timer) - (setq unread-command-events - ;; forces event into current key sequence - (mapcar (lambda (ev) (cons t ev)) - (listify-key-sequence which-key--current-prefix))) - (if which-key--last-try-2-loc - (let ((which-key-side-window-location which-key--last-try-2-loc)) + (if which-key--current-page-n + ;; triggered after timer shows buffer + (let ((next-page (1+ which-key--current-page-n))) + (which-key--stop-timer) + (setq unread-command-events + ;; forces event into current key sequence + (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence which-key--current-prefix))) + (if which-key--last-try-2-loc + (let ((which-key-side-window-location which-key--last-try-2-loc)) + (which-key--show-page next-page)) (which-key--show-page next-page)) - (which-key--show-page next-page)) - (which-key--start-paging-timer))) - + (which-key--start-paging-timer)) + ;; triggered before buffer is showing + (let* ((keysbl (vconcat (butlast (append (this-single-command-keys) nil))))) + (which-key--stop-timer) + (setq unread-command-events + ;; forces event into current key sequence + (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence keysbl))) + (which-key--create-buffer-and-show keysbl) + (which-key--start-timer)))) ;; (defun which-key-show-first-page () ;; "Show the first page of keys." @@ -1080,9 +1091,26 @@ enough space based on your settings and frame size." prefix-keys) (which-key--show-page page-n) loc2)))) -(defun which-key--update () +(defun which-key--create-buffer-and-show (prefix-keys) "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 ((formatted-keys (which-key--get-formatted-key-bindings + (current-buffer))) + (prefix-keys-desc (key-description prefix-keys))) + (cond ((= (length formatted-keys) 0) + (message "%s- which-key: There are no keys to show" prefix-keys-desc)) + ((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 (window-width))) + (which-key--show-page 0))))) + +(defun which-key--update () + "Function run by timer to possibly trigger `which-key--create-buffer-and-show'." (let ((prefix-keys (this-single-command-keys))) ;; (when (> (length prefix-keys) 0) ;; (message "key: %s" (key-description prefix-keys))) @@ -1096,20 +1124,7 @@ Finally, show the buffer." ;; just in case someone uses one of these (keymapp (lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) - (setq which-key--current-prefix prefix-keys - which-key--last-try-2-loc nil) - (let ((formatted-keys (which-key--get-formatted-key-bindings - (current-buffer))) - (prefix-keys-desc (key-description prefix-keys))) - (cond ((= (length formatted-keys) 0) - (message "%s- which-key: There are no keys to show" prefix-keys-desc)) - ((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 (window-width))) - (which-key--show-page 0))))))) + (which-key--create-buffer-and-show prefix-keys)))) ;; Timers commit cf5b9a7cf09c0c59ed66a730ccf7fbd490e54908 Author: Justin Burkett Date: Sun Jul 26 22:04:03 2015 -0400 Add a docstring diff --git a/which-key.el b/which-key.el index 5291b7bdd3d..262544f234f 100644 --- a/which-key.el +++ b/which-key.el @@ -870,6 +870,9 @@ element in each list element of KEYS." (lambda (x y) (max x (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--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)) commit a5413c2b8af110225fabbe64bcad4703c353327c Author: Justin Burkett Date: Sun Jul 26 20:45:42 2015 -0400 Fix some parts of readme diff --git a/README.org b/README.org index c38d0f5c7c3..3db0bed0bbc 100644 --- a/README.org +++ b/README.org @@ -11,10 +11,6 @@ is better though, because it saves the prefix that you just entered. So =C-x C-h C-h C-x= will popup the which-key buffer for the prefix =C-x= change the page twice and then execute the command bound to =C-x C-x=. -- =C-h= will also now popup the which-key buffer to the first page if it is - pressed before =which-key-idle-delay= takes effect. This means you can set a - long idle delay if you like and just use =C-h= when you want to see - =which-key=. ** Introduction =which-key= is a minor mode for Emacs that displays the keybindings following your currently entered incomplete command (a prefix) in a popup. For example, after enabling the minor mode @@ -293,6 +289,7 @@ these alists) #+END_SRC *** Sorting + 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 @@ -310,6 +307,7 @@ The only other built-in option at the moment (besides using nil to turn off sorting completely) is =which-key-description-order=, which orders by the key's description based on the usual ordering of strings after applying =downcase=. +#+NAME: paging *** Paging There are at least several prefixes that have many keys bound to them, like @@ -331,9 +329,7 @@ behavior of emacs which is to show a list of keybindings 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. As a bonus you can type =C-x C-h= and the -which-key buffer will pop up immediately (i.e., before =which-key-idle-delay= -kicks in). +keystroke can complete the command. **** Method 2: Bind your own keys commit 6c206153a35a7dbafbac4ab0b8d2c2314ceded7a Author: Justin Burkett Date: Sun Jul 26 09:03:16 2015 -0400 C-h for paging is awesome diff --git a/README.org b/README.org index 9b0faaa95a7..c38d0f5c7c3 100644 --- a/README.org +++ b/README.org @@ -1,5 +1,20 @@ * which-key [[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]] +** What's new +*** Paging +- Paging is now turned on by default, using any prefix plus =C-h= (this doesn't + affect key sequences that start with =C-h= and will not override any key + sequences that end will =C-h=). See the [[#paging][Paging Section]] for more details and + for other options on using and/or disabling paging. +- This makes which-key function as a replacement for the default behavior of + pressing =C-h= after a prefix which shows the key bindings for any prefix. It + is better though, because it saves the prefix that you just entered. So =C-x + C-h C-h C-x= will popup the which-key buffer for the prefix =C-x= change the + page twice and then execute the command bound to =C-x C-x=. +- =C-h= will also now popup the which-key buffer to the first page if it is + pressed before =which-key-idle-delay= takes effect. This means you can set a + long idle delay if you like and just use =C-h= when you want to see + =which-key=. ** Introduction =which-key= is a minor mode for Emacs that displays the keybindings following your currently entered incomplete command (a prefix) in a popup. For example, after enabling the minor mode @@ -25,6 +40,8 @@ Many of these have been implemented and are described below. ** Table of Contents :TOC@4: - [[#which-key-][which-key ]] + - [[#whats-new][What's new]] + - [[#paging][Paging]] - [[#introduction][Introduction]] - [[#install][Install]] - [[#melpa][MELPA]] @@ -45,6 +62,8 @@ Many of these have been implemented and are described below. - [[#key-and-description-replacement][Key and Description replacement]] - [[#sorting][Sorting]] - [[#paging][Paging]] + - [[#method-1-default-using-c-h-or-help-char][Method 1 (default): Using C-h (or =help-char=)]] + - [[#method-2-bind-your-own-keys][Method 2: Bind your own keys]] - [[#other-options][Other Options]] - [[#more-examples][More Examples]] - [[#nice-display-with-split-frame][Nice Display with Split Frame]] @@ -292,14 +311,34 @@ sorting completely) is =which-key-description-order=, which orders by the key's description based on the usual ordering of strings after applying =downcase=. *** Paging -This is a new feature and may have bugs, so it is disabled by default. 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-show-next-page= which will cycle through -the pages without changing the key sequence you were in the middle of typing. -Essentially, all you need to do to enable this for a prefix like =C-x= is the -following which will bind == to the command. + +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-show-next-page= which will 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-for-paging 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 keybindings 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. As a bonus you can type =C-x C-h= and the +which-key buffer will pop up immediately (i.e., before =which-key-idle-delay= +kicks in). + +**** Method 2: Bind your own keys + +Essentially, all you need to do for a prefix like =C-x= is the following which +will bind == to the relevant command. #+BEGIN_SRC emacs-lisp (define-key which-key-mode-map (kbd "C-x ") 'which-key-show-next-page) diff --git a/which-key.el b/which-key.el index a7a7823e510..5291b7bdd3d 100644 --- a/which-key.el +++ b/which-key.el @@ -200,6 +200,13 @@ prefixes in `which-key-paging-prefixes'" :group 'which-key :type 'string) +(defcustom which-key-use-C-h-for-paging 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) + ;; Faces (defface which-key-key-face '((t . (:inherit font-lock-constant-face))) @@ -277,6 +284,8 @@ to a non-nil value for the execution of a command. Like this 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--lighter-backup nil @@ -302,12 +311,17 @@ Used when `which-key-popup-type' is frame.") (if which-key-mode (progn (unless which-key--is-setup (which-key--setup)) + (when which-key-use-C-h-for-paging + (setq which-key--prefix-help-cmd-backup prefix-help-command + prefix-help-command #'which-key-show-next-page)) (add-hook 'pre-command-hook #'which-key--hide-popup) (add-hook 'pre-command-hook #'which-key--lighter-restore) (add-hook 'focus-out-hook #'which-key--stop-timer) (add-hook 'focus-in-hook #'which-key--start-timer) (which-key--start-timer)) (setq echo-keystrokes which-key--echo-keystrokes-backup) + (when which-key-use-C-h-for-paging + (setq prefix-help-command which-key--prefix-help-cmd-backup)) (remove-hook 'pre-command-hook #'which-key--hide-popup) (remove-hook 'pre-command-hook #'which-key--lighter-restore) (remove-hook 'focus-out-hook #'which-key--stop-timer) @@ -382,7 +396,6 @@ bottom." (setq which-key-popup-type 'minibuffer which-key-show-prefix 'left)) - ;; Helper functions to modify replacement lists. (defun which-key--add-key-based-replacements (alist key repl) @@ -974,16 +987,22 @@ enough space based on your settings and frame size." prefix-keys) (string-width status-left)))) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) (status-left (s-pad-right first-col-width " " status-left)) - (nxt-pg-hint (when (and (< 1 n-pages) - (eq 'which-key-show-next-page - (key-binding - (kbd (concat prefix-keys - " " - which-key-paging-key))))) - (propertize (format "[%s pg %s]" - which-key-paging-key - (1+ (mod (1+ page-n) n-pages))) - 'face 'which-key-note-face))) + (nxt-pg-hint (cond ((and (< 1 n-pages) + which-key-use-C-h-for-paging) + (propertize (format "[C-h pg %s]" + (1+ (mod (1+ page-n) n-pages))) + 'face 'which-key-note-face)) + ((and (< 1 n-pages) + (eq 'which-key-show-next-page + (key-binding + (kbd (concat prefix-keys + " " + which-key-paging-key))))) + (propertize (format "[%s pg %s]" + which-key-paging-key + (1+ (mod (1+ page-n) n-pages))) + 'face 'which-key-note-face)) + (t nil))) new-end lines first) (cond ((and (< 1 n-pages) (eq which-key-show-prefix 'left)) @@ -1029,6 +1048,16 @@ enough space based on your settings and frame size." prefix-keys) (which-key--show-page next-page)) (which-key--start-paging-timer))) + +;; (defun which-key-show-first-page () +;; "Show the first page of keys." +;; ;; (which-key--stop-timer) +;; ;; (setq which-key--prefix-help-cmd-backup prefix-help-command +;; ;; prefix-help-command 'which-key-show-next-page) +;; (which-key--show-page 0) +;; ) +;; ;; (which-key--start-paging-timer)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update @@ -1064,21 +1093,20 @@ Finally, show the buffer." ;; just in case someone uses one of these (keymapp (lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) - (let ((page-n 0)) - (setq which-key--current-prefix prefix-keys - which-key--last-try-2-loc nil) - (let ((formatted-keys (which-key--get-formatted-key-bindings - (current-buffer))) - (prefix-keys-desc (key-description prefix-keys))) - (cond ((= (length formatted-keys) 0) - (message "%s- which-key: There are no keys to show" prefix-keys-desc)) - ((listp which-key-side-window-location) - (setq which-key--last-try-2-loc - (apply #'which-key--try-2-side-windows - formatted-keys page-n which-key-side-window-location))) - (t (setq which-key--pages-plist - (which-key--create-pages formatted-keys (window-width))) - (which-key--show-page page-n)))))))) + (setq which-key--current-prefix prefix-keys + which-key--last-try-2-loc nil) + (let ((formatted-keys (which-key--get-formatted-key-bindings + (current-buffer))) + (prefix-keys-desc (key-description prefix-keys))) + (cond ((= (length formatted-keys) 0) + (message "%s- which-key: There are no keys to show" prefix-keys-desc)) + ((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 (window-width))) + (which-key--show-page 0))))))) ;; Timers @@ -1102,6 +1130,7 @@ Finally, show the buffer." (and (< 0 (length (this-single-command-keys))) (not (equal which-key--current-prefix (this-single-command-keys))))) + (setq which-key--current-page-n nil) (cancel-timer which-key--paging-timer) (which-key--start-timer)))))) commit ae3160876724fca277a53476ce4e5a86ae751b68 Author: Justin Burkett Date: Sat Jul 25 14:54:33 2015 -0400 Add next page hint to show-prefix top Also introduce which-key-note-face for notes and hints, and change format of next page hint slightly. diff --git a/which-key.el b/which-key.el index 609857de9f9..a7a7823e510 100644 --- a/which-key.el +++ b/which-key.el @@ -211,6 +211,11 @@ prefixes in `which-key-paging-prefixes'" "Face for the separator (default separator is an arrow)" :group 'which-key) +(defface which-key-note-face + '((t . (:inherit which-key-separator-face))) + "Face for notes or hints occasionally provided" + :group 'which-key) + (defface which-key-command-description-face '((t . (:inherit font-lock-function-name-face))) "Face for the key description when it is a command" @@ -964,7 +969,7 @@ enough space based on your settings and frame size." prefix-keys) 'face 'which-key-separator-face)) (status-top (when (< 1 n-pages) (propertize (format "(%s of %s)" (1+ page-n) n-pages) - 'face 'which-key-separator-face))) + 'face 'which-key-note-face))) (first-col-width (+ 2 (max (string-width prefix-w-face) (string-width status-left)))) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) @@ -975,10 +980,10 @@ enough space based on your settings and frame size." prefix-keys) (kbd (concat prefix-keys " " which-key-paging-key))))) - (propertize (concat "press " + (propertize (format "[%s pg %s]" which-key-paging-key - " for next page") - 'face 'which-key-separator-face))) + (1+ (mod (1+ page-n) n-pages))) + 'face 'which-key-note-face))) new-end lines first) (cond ((and (< 1 n-pages) (eq which-key-show-prefix 'left)) @@ -994,12 +999,11 @@ enough space based on your settings and frame size." prefix-keys) new-end (concat "\n" (s-repeat first-col-width " ")) page (concat first (mapconcat #'identity (cdr lines) new-end))))) ((eq which-key-show-prefix 'top) - (setq page (concat prefix-w-face dash-w-face " " status-top "\n" page))) + (setq page (concat prefix-w-face dash-w-face " " + status-top " " nxt-pg-hint "\n" page))) ((eq which-key-show-prefix 'echo) - (which-key--echo (concat prefix-w-face - dash-w-face " " - status-top - " " nxt-pg-hint)))) + (which-key--echo (concat prefix-w-face dash-w-face " " + status-top " " nxt-pg-hint)))) (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) (which-key--echo page) commit ad0fcac8a3e9c862efed47a106e5c9efdf208da9 Author: Justin Burkett Date: Sat Jul 25 11:49:19 2015 -0400 Add hint for next page key Only shows when using echo for which-key-show-prefix See #53 diff --git a/which-key.el b/which-key.el index 32cf4e3b58a..609857de9f9 100644 --- a/which-key.el +++ b/which-key.el @@ -961,14 +961,24 @@ enough space based on your settings and frame size." prefix-keys) (prefix-w-face (which-key--propertize-key prefix-keys)) (dash-w-face (propertize "-" 'face 'which-key-key-face)) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) - 'face 'font-lock-comment-face)) + 'face 'which-key-separator-face)) (status-top (when (< 1 n-pages) (propertize (format "(%s of %s)" (1+ page-n) n-pages) - 'face 'font-lock-comment-face))) + 'face 'which-key-separator-face))) (first-col-width (+ 2 (max (string-width prefix-w-face) (string-width status-left)))) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) (status-left (s-pad-right first-col-width " " status-left)) + (nxt-pg-hint (when (and (< 1 n-pages) + (eq 'which-key-show-next-page + (key-binding + (kbd (concat prefix-keys + " " + which-key-paging-key))))) + (propertize (concat "press " + which-key-paging-key + " for next page") + 'face 'which-key-separator-face))) new-end lines first) (cond ((and (< 1 n-pages) (eq which-key-show-prefix 'left)) @@ -986,7 +996,10 @@ enough space based on your settings and frame size." prefix-keys) ((eq which-key-show-prefix 'top) (setq page (concat prefix-w-face dash-w-face " " status-top "\n" page))) ((eq which-key-show-prefix 'echo) - (which-key--echo (concat prefix-w-face dash-w-face " " status-top)))) + (which-key--echo (concat prefix-w-face + dash-w-face " " + status-top + " " nxt-pg-hint)))) (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) (which-key--echo page) commit cf6ffc985b3f91cf207e5c38ef540eb2f7c29c44 Author: Justin Burkett Date: Sat Jul 25 10:19:24 2015 -0400 Fix show-next-page problem with mult events Need to add (t . event) to unread-command-events to force emacs to add each event to the current command's sequence. See docs for unread-command-events. diff --git a/which-key.el b/which-key.el index 2d49e62f13d..32cf4e3b58a 100644 --- a/which-key.el +++ b/which-key.el @@ -1003,7 +1003,9 @@ enough space based on your settings and frame size." prefix-keys) (1+ which-key--current-page-n) 0))) (which-key--stop-timer) (setq unread-command-events - (listify-key-sequence which-key--current-prefix)) + ;; forces event into current key sequence + (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence which-key--current-prefix))) (if which-key--last-try-2-loc (let ((which-key-side-window-location which-key--last-try-2-loc)) (which-key--show-page next-page)) commit 39f4bb01f034e2c96da3db403b8f2cd5a1d4d0cc Author: Justin Burkett Date: Fri Jul 24 10:17:19 2015 -0400 Documentation is better now :-) diff --git a/README.org b/README.org index 371124b3b61..9b0faaa95a7 100644 --- a/README.org +++ b/README.org @@ -76,7 +76,7 @@ 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 (which are configurable but not well documented at the moment). +settings, most of which are described below. By default which-key makes substitutions for text all with the aim of saving space. The most noticeable are the "special keys" like SPC, TAB, RET, etc. This commit e80857a4d8df328ab16fe9a0f6a019b46de9c043 Author: Justin Burkett Date: Fri Jul 24 10:14:58 2015 -0400 Add link to README about disabling special keys diff --git a/README.org b/README.org index 70a84011c91..371124b3b61 100644 --- a/README.org +++ b/README.org @@ -80,9 +80,10 @@ settings (which are configurable but not well documented at the moment). By default which-key makes substitutions for text all with the aim of saving space. The most noticeable are the "special keys" like SPC, TAB, RET, etc. This -can be turned off, but the default is to truncate these keys to one character -and display them using =:inverse-video= (flips foreground and background -colors). You can see the effect in the screenshots. +can be turned off (see [[#other-options][Other Options]]), but the default is to +truncate these keys to one character and display them using =:inverse-video= +(flips foreground and background colors). You can see the effect in the +screenshots. There are other substitution abilities included, which are quite flexible (ability to use regexp for example). This makes which-key very customizable. @@ -333,8 +334,9 @@ shown. (setq which-key-separator " → " ) (setq which-key-unicode-correction 3) - ;; Set the special keys. These are automatically truncated to one character - ;; and have which-key-special-key-face applied. + ;; Set the special keys. These are automatically truncated to one character and + ;; have which-key-special-key-face applied. Set this variable to nil to disable + ;; the feature (setq which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL")) ;; Show the key prefix on the left or top (nil means hide the prefix). The commit c808fda5a9091b07b07fd14c842e961d1ab4ff69 Author: Justin Burkett Date: Fri Jul 24 09:52:41 2015 -0400 Allow which-key-special-keys to be nil diff --git a/which-key.el b/which-key.el index 1f3966ba282..2d49e62f13d 100644 --- a/which-key.el +++ b/which-key.el @@ -720,7 +720,8 @@ If KEY contains any \"special keys\" defined in (mapconcat 'identity which-key-special-keys "\\|") "\\)"))) (save-match-data - (if (string-match regexp key) + (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)) commit b93e70db7b8e7be5512e9d2455680546343409f4 Author: Justin Burkett Date: Thu Jul 23 22:47:09 2015 -0400 Switch to lexical binding and fix warnings diff --git a/which-key.el b/which-key.el index ae649c22a73..1f3966ba282 100644 --- a/which-key.el +++ b/which-key.el @@ -1,4 +1,4 @@ -;;; which-key.el --- Display available keybindings in popup +;;; which-key.el --- Display available keybindings in popup -*- lexical-binding: t; -*- ;; Copyright (C) 2015 Justin Burkett @@ -279,29 +279,29 @@ Used when `which-key-popup-type' is frame.") (defvar which-key--current-prefix nil "Internal: Holds current prefix") (defvar which-key--current-page-n nil) -(defvar which-key--force-next-page-n nil) +(defvar which-key--last-try-2-loc nil) ;;;###autoload (define-minor-mode which-key-mode "Toggle which-key-mode." :global t :lighter " WK" - :keymap '() + :keymap (let ((map (make-sparse-keymap))) + (mapc + (lambda (prefix) + (define-key map + (kbd (concat prefix " " which-key-paging-key)) + #'which-key-show-next-page)) + which-key-paging-prefixes) + map) (if which-key-mode (progn (unless which-key--is-setup (which-key--setup)) - ;; bind keys for paging - (mapc (lambda (prefix) - (define-key which-key-mode-map - (kbd (concat prefix " " which-key-paging-key)) - #'which-key-show-next-page)) - which-key-paging-prefixes) (add-hook 'pre-command-hook #'which-key--hide-popup) (add-hook 'pre-command-hook #'which-key--lighter-restore) (add-hook 'focus-out-hook #'which-key--stop-timer) (add-hook 'focus-in-hook #'which-key--start-timer) (which-key--start-timer)) - ;; make sure echo-keystrokes returns to original value (setq echo-keystrokes which-key--echo-keystrokes-backup) (remove-hook 'pre-command-hook #'which-key--hide-popup) (remove-hook 'pre-command-hook #'which-key--lighter-restore) @@ -314,7 +314,7 @@ Used when `which-key-popup-type' is frame.") Reduce `echo-keystrokes' if necessary (it will interfer if it's set too high) and setup which-key buffer." (when (or (eq which-key-show-prefix 'echo) - (eq which-key-popup-type 'minibuffer)) + (eq which-key-popup-type 'minibuffer)) (which-key--setup-echo-keystrokes)) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer @@ -461,15 +461,15 @@ character width as the frame." ;; add padding to account for possible wide (unicode) characters 3))) -(defun which-key--char-enlarged-p (&optional frame) +(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) +(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) +(defun which-key--char-exact-p (&optional _frame) (= (frame-char-width) (/ (float (frame-pixel-width)) (window-total-width (frame-root-window))))) @@ -563,7 +563,7 @@ call signature in different emacs versions" (defun which-key--show-buffer-frame (act-popup-dim) "Show which-key buffer when popup type is frame." - (let* ((orig-window (selected-window)) + (let* (;(orig-window (selected-window)) (frame-height (+ (car act-popup-dim) (if (with-current-buffer which-key--buffer mode-line-format) @@ -818,8 +818,7 @@ Uses `string-lessp' after applying lowercase." "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." (let ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) - key-match desc-match unformatted format-res - formatted column-width) + key-match desc-match unformatted) (with-temp-buffer (describe-buffer-bindings buffer which-key--current-prefix) (goto-char (point-max)) ; want to put last keys in first @@ -910,7 +909,7 @@ element in each list element of KEYS." (vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) (result (which-key--partition-columns keys avl-lines avl-width)) - pages keys/page n-pages found prev-result) + found prev-result) (cond ((or vertical (> (plist-get result :n-pages) 1) (= 1 avl-lines)) result) ;; do a simple search for the smallest number of lines @@ -935,14 +934,13 @@ element in each list element of KEYS." "Echo TEXT to minibuffer without logging. Slight delay gets around evil functions that clear the echo area." - (eval - `(let* ((minibuffer (eq which-key-popup-type 'minibuffer)) - (delay (if minibuffer 0.2 0.01)) - message-log-max) - (unless minibuffer (message "%s" ,text)) - (run-with-idle-timer delay nil - (lambda () (let (message-log-max) - (message "%s" ,text))))))) + (let* ((minibuffer (eq which-key-popup-type 'minibuffer)) + (delay (if minibuffer 0.2 0.01)) + message-log-max) + (unless minibuffer (message "%s" text)) + (run-with-idle-timer + delay nil (lambda () (let (message-log-max) + (message "%s" text)))))) (defun which-key--show-page (n) "Show page N, starting from 0." @@ -970,7 +968,7 @@ enough space based on your settings and frame size." prefix-keys) (string-width status-left)))) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) (status-left (s-pad-right first-col-width " " status-left)) - new-end lines) + new-end lines first) (cond ((and (< 1 n-pages) (eq which-key-show-prefix 'left)) (setq lines (split-string page "\n") @@ -1003,27 +1001,32 @@ enough space based on your settings and frame size." prefix-keys) (let ((next-page (if which-key--current-page-n (1+ which-key--current-page-n) 0))) (which-key--stop-timer) - (setq unread-command-events - (listify-key-sequence which-key--current-prefix)) - (which-key--show-page next-page) - (which-key--start-paging-timer))) + (setq unread-command-events + (listify-key-sequence which-key--current-prefix)) + (if which-key--last-try-2-loc + (let ((which-key-side-window-location which-key--last-try-2-loc)) + (which-key--show-page next-page)) + (which-key--show-page next-page)) + (which-key--start-paging-timer))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update -(defun which-key--try-2-side-windows (page-n loc1 loc2 &rest _ignore) - (let (pages1 pages2) +(defun which-key--try-2-side-windows (keys page-n loc1 loc2 &rest _ignore) + (let (pages1) (let ((which-key-side-window-location loc1)) - (setq pages1 (which-key--create-pages formatted-keys (window-width)))) + (setq pages1 (which-key--create-pages keys (window-width)))) (if (< 0 (plist-get pages1 :n-pages)) (progn (setq which-key--pages-plist pages1) (let ((which-key-side-window-location loc1)) - (which-key--show-page page-n))) + (which-key--show-page page-n)) + loc1) (let ((which-key-side-window-location loc2)) (setq which-key--pages-plist (which-key--create-pages - formatted-keys (window-width))) - (which-key--show-page page-n))))) + keys (window-width))) + (which-key--show-page page-n) + loc2)))) (defun which-key--update () "Fill `which-key--buffer' with key descriptions and reformat. @@ -1042,15 +1045,17 @@ Finally, show the buffer." (keymapp (lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) (let ((page-n 0)) - (setq which-key--current-prefix prefix-keys) + (setq which-key--current-prefix prefix-keys + which-key--last-try-2-loc nil) (let ((formatted-keys (which-key--get-formatted-key-bindings (current-buffer))) - (prefix-keys-desc (key-description prefix-keys)) - pages-right pages-bottom) + (prefix-keys-desc (key-description prefix-keys))) (cond ((= (length formatted-keys) 0) (message "%s- which-key: There are no keys to show" prefix-keys-desc)) ((listp which-key-side-window-location) - (apply #'which-key--try-2-side-windows page-n which-key-side-window-location)) + (setq which-key--last-try-2-loc + (apply #'which-key--try-2-side-windows + formatted-keys page-n which-key-side-window-location))) (t (setq which-key--pages-plist (which-key--create-pages formatted-keys (window-width))) (which-key--show-page page-n)))))))) commit ffc65fd6df84f9adebc58b1b6809d81dfae72279 Author: Justin Burkett Date: Thu Jul 23 15:04:29 2015 -0400 Fix echo function diff --git a/which-key.el b/which-key.el index 63028765cd7..ae649c22a73 100644 --- a/which-key.el +++ b/which-key.el @@ -940,7 +940,9 @@ area." (delay (if minibuffer 0.2 0.01)) message-log-max) (unless minibuffer (message "%s" ,text)) - (run-with-idle-timer delay nil (lambda () (message "%s" ,text)))))) + (run-with-idle-timer delay nil + (lambda () (let (message-log-max) + (message "%s" ,text))))))) (defun which-key--show-page (n) "Show page N, starting from 0." commit 4cb5a5c39977d3bd6c2a6ec392f7e11b9f247d33 Author: Justin Burkett Date: Thu Jul 23 10:21:04 2015 -0400 Add suggestion about tiling wm to readme diff --git a/README.org b/README.org index 2e60e24a4e1..70a84011c91 100644 --- a/README.org +++ b/README.org @@ -126,7 +126,9 @@ Popup side window on bottom. This is the current default. To restore this setup *** 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. +usually easier to fit keys into. This setting can be helpful if the size of +the Emacs frame changes frequently, which might be the caes if you are using +a dynamic/tiling window manager. #+BEGIN_SRC emacs-lisp (which-key-setup-side-window-right-bottom) commit 7c5f91db5159497e7f78502be74f92704bdc4583 Author: Justin Burkett Date: Wed Jul 22 21:20:32 2015 -0400 Better strategy for dealing with minibuffer paging diff --git a/which-key.el b/which-key.el index 217251674de..63028765cd7 100644 --- a/which-key.el +++ b/which-key.el @@ -42,8 +42,7 @@ :group 'which-key :type 'float) -(defcustom which-key-echo-keystrokes - (min echo-keystrokes (/ (float which-key-idle-delay) 4)) +(defcustom which-key-echo-keystrokes 0 "Value to use for `echo-keystrokes'. This only applies when `which-key-popup-type' is minibuffer. It needs to be less than `which-key-idle-delay' or else the echo @@ -932,6 +931,17 @@ element in each list element of KEYS." (when which-key-show-remaining-keys (setcar (cdr (assq 'which-key-mode minor-mode-alist)) which-key--lighter-backup))) +(defun which-key--echo (text) + "Echo TEXT to minibuffer without logging. +Slight delay gets around evil functions that clear the echo +area." + (eval + `(let* ((minibuffer (eq which-key-popup-type 'minibuffer)) + (delay (if minibuffer 0.2 0.01)) + message-log-max) + (unless minibuffer (message "%s" ,text)) + (run-with-idle-timer delay nil (lambda () (message "%s" ,text)))))) + (defun which-key--show-page (n) "Show page N, starting from 0." (let ((n-pages (plist-get which-key--pages-plist :n-pages)) @@ -940,10 +950,7 @@ element in each list element of KEYS." (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) - (if which-key--force-next-page-n - (setq page-n (mod which-key--force-next-page-n n-pages) - which-key--force-next-page-n nil) - (setq page-n (mod n n-pages))) + (setq page-n (mod n n-pages)) (setq which-key--current-page-n page-n) (let* ((page (nth page-n (plist-get which-key--pages-plist :pages))) (height (plist-get which-key--pages-plist :page-height)) @@ -978,11 +985,10 @@ enough space based on your settings and frame size." prefix-keys) ((eq which-key-show-prefix 'top) (setq page (concat prefix-w-face dash-w-face " " status-top "\n" page))) ((eq which-key-show-prefix 'echo) - (let (message-log-max) - (message "%s" (concat prefix-w-face dash-w-face " " status-top))))) + (which-key--echo (concat prefix-w-face dash-w-face " " status-top)))) (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) - (let (message-log-max) (message "%s" page)) + (which-key--echo page) (with-current-buffer which-key--buffer (erase-buffer) (insert page) @@ -995,15 +1001,10 @@ enough space based on your settings and frame size." prefix-keys) (let ((next-page (if which-key--current-page-n (1+ which-key--current-page-n) 0))) (which-key--stop-timer) - (if (eq which-key-popup-type 'minibuffer) - (progn (setq which-key--force-next-page-n next-page) - (which-key--start-timer) - (setq unread-command-events - (listify-key-sequence which-key--current-prefix))) (setq unread-command-events (listify-key-sequence which-key--current-prefix)) (which-key--show-page next-page) - (which-key--start-paging-timer)))) + (which-key--start-paging-timer))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update commit f5eb098b0ed6f044f10ce60889acc94d11590b8c Author: Justin Burkett Date: Wed Jul 22 20:39:35 2015 -0400 Hack to fix #48 diff --git a/which-key.el b/which-key.el index ce65ced8fd7..217251674de 100644 --- a/which-key.el +++ b/which-key.el @@ -280,6 +280,7 @@ Used when `which-key-popup-type' is frame.") (defvar which-key--current-prefix nil "Internal: Holds current prefix") (defvar which-key--current-page-n nil) +(defvar which-key--force-next-page-n nil) ;;;###autoload (define-minor-mode which-key-mode @@ -934,23 +935,27 @@ element in each list element of KEYS." (defun which-key--show-page (n) "Show page N, starting from 0." (let ((n-pages (plist-get which-key--pages-plist :n-pages)) - (prefix-keys (key-description which-key--current-prefix))) + (prefix-keys (key-description which-key--current-prefix)) + page-n) (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 which-key--current-page-n n) - (let* ((i (mod n n-pages)) - (page (nth i (plist-get which-key--pages-plist :pages))) + (if which-key--force-next-page-n + (setq page-n (mod which-key--force-next-page-n n-pages) + which-key--force-next-page-n nil) + (setq page-n (mod n n-pages))) + (setq which-key--current-page-n page-n) + (let* ((page (nth page-n (plist-get which-key--pages-plist :pages))) (height (plist-get which-key--pages-plist :page-height)) - (width (nth i (plist-get which-key--pages-plist :page-widths))) - (n-shown (nth i (plist-get which-key--pages-plist :keys/page))) + (width (nth page-n (plist-get which-key--pages-plist :page-widths))) + (n-shown (nth page-n (plist-get which-key--pages-plist :keys/page))) (n-tot (plist-get which-key--pages-plist :tot-keys)) (prefix-w-face (which-key--propertize-key prefix-keys)) (dash-w-face (propertize "-" 'face 'which-key-key-face)) - (status-left (propertize (format "%s/%s" (1+ i) n-pages) + (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'font-lock-comment-face)) (status-top (when (< 1 n-pages) - (propertize (format "(%s of %s)" (1+ i) n-pages) + (propertize (format "(%s of %s)" (1+ page-n) n-pages) 'face 'font-lock-comment-face))) (first-col-width (+ 2 (max (string-width prefix-w-face) (string-width status-left)))) @@ -990,9 +995,15 @@ enough space based on your settings and frame size." prefix-keys) (let ((next-page (if which-key--current-page-n (1+ which-key--current-page-n) 0))) (which-key--stop-timer) - (setq unread-command-events (listify-key-sequence which-key--current-prefix)) - (which-key--show-page next-page) - (which-key--start-paging-timer))) + (if (eq which-key-popup-type 'minibuffer) + (progn (setq which-key--force-next-page-n next-page) + (which-key--start-timer) + (setq unread-command-events + (listify-key-sequence which-key--current-prefix))) + (setq unread-command-events + (listify-key-sequence which-key--current-prefix)) + (which-key--show-page next-page) + (which-key--start-paging-timer)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update commit d896af6371b3b302838ba1de00c30c6a2f67e961 Author: Justin Burkett Date: Wed Jul 22 17:15:30 2015 -0400 Allow side-window bottom to be shorter than 4 diff --git a/which-key.el b/which-key.el index b30e0b7ebd1..ce65ced8fd7 100644 --- a/which-key.el +++ b/which-key.el @@ -541,7 +541,7 @@ call signature in different emacs versions" "Show which-key buffer when popup type is side-window." (let* ((side which-key-side-window-location) (alist '((window-width . which-key--fit-buffer-to-window-horizontally) - (window-height . fit-window-to-buffer)))) + (window-height . (lambda (w) (fit-window-to-buffer w nil 1)))))) ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' ;; were added in Emacs 24.3 commit ab0dacc305de2294c43826891a3dcd4c516e1907 Author: Justin Burkett Date: Wed Jul 22 16:31:00 2015 -0400 Fix key/page count and bug in create-pages diff --git a/which-key.el b/which-key.el index bff977b0896..b30e0b7ebd1 100644 --- a/which-key.el +++ b/which-key.el @@ -867,8 +867,8 @@ element in each list element of KEYS." (defun which-key--partition-columns (keys avl-lines avl-width) (let ((cols-w-widths (mapcar #'which-key--pad-column (-partition-all avl-lines keys))) - (page-width 0) (n-pages 0) - page-cols pages keys/page page-widths) + (page-width 0) (n-pages 0) (n-keys 0) + page-cols pages page-widths keys/page) (if (> (car (car cols-w-widths)) avl-width) ;; give up if first column doesn't fit (list :pages nil :page-height 0 :page-widths '(0) @@ -876,17 +876,19 @@ element in each list element of KEYS." (dolist (col cols-w-widths) (if (<= (+ (car col) page-width) avl-width) (progn (push (cdr col) page-cols) - (setq page-width (+ page-width (car col)))) + (setq page-width (+ page-width (car col)) + n-keys (+ (length (cdr col)) n-keys))) (when (> (length page-cols) 0) (push (which-key--join-columns page-cols) pages) - (push (* (length page-cols) avl-lines) keys/page) + (push n-keys keys/page) (push page-width page-widths) (setq n-pages (1+ n-pages) + n-keys (length (cdr col)) page-cols (list (cdr col)) page-width (car col))))) (when (> (length page-cols) 0) (push (which-key--join-columns page-cols) pages) - (push (* (length page-cols) avl-lines) keys/page) + (push n-keys keys/page) (push page-width page-widths) (setq n-pages (1+ n-pages))) (list :pages (reverse pages) :page-height avl-lines @@ -918,7 +920,7 @@ element in each list element of KEYS." result (which-key--partition-columns keys avl-lines avl-width) found (> (plist-get result :n-pages) 1))) - (if (and (> avl-lines 1) found) prev-result result))))) + (if found prev-result result))))) (defun which-key--lighter-status (n-shown n-tot) (when which-key-show-remaining-keys commit ed30e62cc892bc381477b44c4eb50ce43a63f639 Author: Justin Burkett Date: Wed Jul 22 16:10:31 2015 -0400 Simplify show page a little diff --git a/which-key.el b/which-key.el index cc98e2e7cdb..bff977b0896 100644 --- a/which-key.el +++ b/which-key.el @@ -947,8 +947,9 @@ enough space based on your settings and frame size." prefix-keys) (dash-w-face (propertize "-" 'face 'which-key-key-face)) (status-left (propertize (format "%s/%s" (1+ i) n-pages) 'face 'font-lock-comment-face)) - (status-top (propertize (format "(%s of %s)" (1+ i) n-pages) - 'face 'font-lock-comment-face)) + (status-top (when (< 1 n-pages) + (propertize (format "(%s of %s)" (1+ i) n-pages) + 'face 'font-lock-comment-face))) (first-col-width (+ 2 (max (string-width prefix-w-face) (string-width status-left)))) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) @@ -967,16 +968,11 @@ enough space based on your settings and frame size." prefix-keys) first (concat prefix-left (car lines) "\n" (s-repeat first-col-width " ")) new-end (concat "\n" (s-repeat first-col-width " ")) page (concat first (mapconcat #'identity (cdr lines) new-end))))) - ((and (< 1 n-pages) - (eq which-key-show-prefix 'top)) - (setq page (concat prefix-w-face dash-w-face " " status-top "\n" page))) ((eq which-key-show-prefix 'top) - (setq page (concat prefix-w-face dash-w-face " \n" page))) - ((and (< 1 n-pages) - (eq which-key-show-prefix 'echo)) - (let (message-log-max) (message "%s" (concat prefix-w-face dash-w-face " " status-top)))) + (setq page (concat prefix-w-face dash-w-face " " status-top "\n" page))) ((eq which-key-show-prefix 'echo) - (let (message-log-max) (message "%s" (concat prefix-w-face dash-w-face " "))))) + (let (message-log-max) + (message "%s" (concat prefix-w-face dash-w-face " " status-top))))) (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" page)) commit 5d0bb5cab113839cf6f510a88d414c551762d038 Author: Justin Burkett Date: Wed Jul 22 14:56:50 2015 -0400 Bump version for new defaults diff --git a/which-key.el b/which-key.el index f753b74756a..cc98e2e7cdb 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.3 +;; Version: 0.4 ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) commit 710b1ef795cfb4f14b94251b4c999d4c562c4ce1 Author: Justin Burkett Date: Wed Jul 22 14:50:01 2015 -0400 Make side-window bottom the default Also adds echo as the new default for the prefix key information (to use the echo area). Making side-window bottom the default location, because it seems to have the best behavior overall after adding paging. Don't want to use the minibuffer because it's misbehaving right now. Change echo-keystrokes if prefix is echo diff --git a/README.org b/README.org index 26a507f47da..2e60e24a4e1 100644 --- a/README.org +++ b/README.org @@ -89,7 +89,7 @@ There are other substitution abilities included, which are quite flexible This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacemacs]]. *** Minibuffer Option -Take over the minibuffer. Setup by default, but you can also use +Take over the minibuffer. For the recommended configuration use #+BEGIN_SRC emacs-lisp (which-key-setup-minibuffer) @@ -115,7 +115,7 @@ width (see =M-x customize-group which-key=). [[./img/which-key-right.png]] *** Side Window Bottom Option -Popup side window on bottom. For defaults use +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) diff --git a/which-key.el b/which-key.el index 8a7a671a705..f753b74756a 100644 --- a/which-key.el +++ b/which-key.el @@ -119,16 +119,17 @@ and have `which-key-special-key-face' applied to them." :group 'which-key :type 'string) -(defcustom which-key-show-prefix 'left +(defcustom which-key-show-prefix 'echo "Whether to and where to display the current prefix sequence. -Possible choices are left (the default), top and nil. Nil turns -the feature off." +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 keys" left) (const :tag "In first line" top) + (const :tag "In echo area" echo) (const :tag "Hide" nil))) -(defcustom which-key-popup-type 'minibuffer +(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) @@ -136,7 +137,7 @@ the feature off." (const :tag "Show in popup frame" frame) (const :tag "Use your custom display functions" custom))) -(defcustom which-key-side-window-location 'right +(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 @@ -312,7 +313,8 @@ Used when `which-key-popup-type' is frame.") "Initial setup for which-key. Reduce `echo-keystrokes' if necessary (it will interfer if it's set too high) and setup which-key buffer." - (when (eq which-key-popup-type 'minibuffer) + (when (or (eq which-key-show-prefix 'echo) + (eq which-key-popup-type 'minibuffer)) (which-key--setup-echo-keystrokes)) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer @@ -362,9 +364,10 @@ it's set too high)." "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 nil)) + which-key-show-prefix 'echo)) ;;;###autoload (defun which-key-setup-minibuffer () @@ -941,6 +944,7 @@ enough space based on your settings and frame size." prefix-keys) (n-shown (nth i (plist-get which-key--pages-plist :keys/page))) (n-tot (plist-get which-key--pages-plist :tot-keys)) (prefix-w-face (which-key--propertize-key prefix-keys)) + (dash-w-face (propertize "-" 'face 'which-key-key-face)) (status-left (propertize (format "%s/%s" (1+ i) n-pages) 'face 'font-lock-comment-face)) (status-top (propertize (format "(%s of %s)" (1+ i) n-pages) @@ -965,9 +969,14 @@ enough space based on your settings and frame size." prefix-keys) page (concat first (mapconcat #'identity (cdr lines) new-end))))) ((and (< 1 n-pages) (eq which-key-show-prefix 'top)) - (setq page (concat prefix-w-face "- " status-top "\n" page))) + (setq page (concat prefix-w-face dash-w-face " " status-top "\n" page))) ((eq which-key-show-prefix 'top) - (setq page (concat prefix-w-face "- \n" page)))) + (setq page (concat prefix-w-face dash-w-face " \n" page))) + ((and (< 1 n-pages) + (eq which-key-show-prefix 'echo)) + (let (message-log-max) (message "%s" (concat prefix-w-face dash-w-face " " status-top)))) + ((eq which-key-show-prefix 'echo) + (let (message-log-max) (message "%s" (concat prefix-w-face dash-w-face " "))))) (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" page)) @@ -1059,8 +1068,5 @@ Finally, show the buffer." (cancel-timer which-key--paging-timer) (which-key--start-timer)))))) -;; TODO -;; fix status key - (provide 'which-key) ;;; which-key.el ends here commit f454e02490deeffd1ce53d19933ef1322c33b2ee Author: Justin Burkett Date: Wed Jul 22 14:34:29 2015 -0400 Add default replacement for next page diff --git a/which-key.el b/which-key.el index 6024d148427..8a7a671a705 100644 --- a/which-key.el +++ b/which-key.el @@ -87,7 +87,7 @@ in the first example." :type '(alist :key-type regexp :value-type string)) (defcustom which-key-description-replacement-alist - '(("Prefix Command" . "prefix")) + '(("Prefix Command" . "prefix") ("which-key-show-next-page" . "wk next pg")) "See `which-key-key-replacement-alist'. This is a list of lists for replacing descriptions." :group 'which-key commit 2b442b17c2a953c33e48125206740ea42ecdef56 Author: Justin Burkett Date: Wed Jul 22 14:32:00 2015 -0400 Factor out paging timer and only start once diff --git a/which-key.el b/which-key.el index 74b068d2e14..6024d148427 100644 --- a/which-key.el +++ b/which-key.el @@ -263,6 +263,8 @@ to a non-nil value for the execution of a command. Like this "Internal: Holds reference to which-key window.") (defvar which-key--timer nil "Internal: Holds reference to open window timer.") +(defvar which-key--paging-timer nil + "Internal: Holds reference to timer for paging.") (defvar which-key--is-setup nil "Internal: Non-nil if which-key buffer has been setup.") (defvar which-key--frame nil @@ -983,16 +985,7 @@ enough space based on your settings and frame size." prefix-keys) (which-key--stop-timer) (setq unread-command-events (listify-key-sequence which-key--current-prefix)) (which-key--show-page next-page) - (let (timer) - (setq timer - (run-with-idle-timer 0.2 t - (lambda () - (when (or (not (eq real-last-command 'which-key-show-next-page)) - (and (< 0 (length (this-single-command-keys))) - (not (equal which-key--current-prefix - (this-single-command-keys))))) - (cancel-timer timer) - (which-key--start-timer)))))))) + (which-key--start-paging-timer))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update @@ -1053,6 +1046,18 @@ Finally, show the buffer." "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)) + (setq which-key--paging-timer + (run-with-idle-timer + 0.2 t (lambda () + (when (or (not (eq real-last-command 'which-key-show-next-page)) + (and (< 0 (length (this-single-command-keys))) + (not (equal which-key--current-prefix + (this-single-command-keys))))) + (cancel-timer which-key--paging-timer) + (which-key--start-timer)))))) ;; TODO ;; fix status key commit 66dc4dd2e8af535a47f7d38019e5dec32e55df77 Author: Justin Burkett Date: Wed Jul 22 12:56:26 2015 -0400 Fix some hash quotes diff --git a/which-key.el b/which-key.el index 5429eac9824..74b068d2e14 100644 --- a/which-key.el +++ b/which-key.el @@ -291,7 +291,7 @@ Used when `which-key-popup-type' is frame.") (mapc (lambda (prefix) (define-key which-key-mode-map (kbd (concat prefix " " which-key-paging-key)) - 'which-key-show-next-page)) + #'which-key-show-next-page)) which-key-paging-prefixes) (add-hook 'pre-command-hook #'which-key--hide-popup) (add-hook 'pre-command-hook #'which-key--lighter-restore) @@ -1047,7 +1047,7 @@ Finally, show the buffer." "Activate idle timer to trigger `which-key--update'." (which-key--stop-timer) ; start over (setq which-key--timer - (run-with-idle-timer which-key-idle-delay t 'which-key--update))) + (run-with-idle-timer which-key-idle-delay t #'which-key--update))) (defun which-key--stop-timer () "Deactivate idle timer for `which-key--update'." commit db469b2188c7fbd5a6aea2d3d77b6899b8db568b Author: Justin Burkett Date: Wed Jul 22 12:54:16 2015 -0400 Protect 2-side-window function from too many args diff --git a/which-key.el b/which-key.el index 9b2dff0a642..5429eac9824 100644 --- a/which-key.el +++ b/which-key.el @@ -997,7 +997,7 @@ enough space based on your settings and frame size." prefix-keys) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update -(defun which-key--try-2-side-windows (page-n loc1 loc2) +(defun which-key--try-2-side-windows (page-n loc1 loc2 &rest _ignore) (let (pages1 pages2) (let ((which-key-side-window-location loc1)) (setq pages1 (which-key--create-pages formatted-keys (window-width)))) commit 5f35908078125d0f6a28005e8d5705589b996f25 Author: Justin Burkett Date: Wed Jul 22 12:49:59 2015 -0400 Remove show and hide functions for minibuffer diff --git a/which-key.el b/which-key.el index c2c89abc296..9b2dff0a642 100644 --- a/which-key.el +++ b/which-key.el @@ -494,16 +494,12 @@ total height." (defun which-key--hide-popup () "This function is called to hide the which-key buffer." (cl-case which-key-popup-type - (minibuffer (which-key--hide-buffer-minibuffer)) + ;; 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-buffer-minibuffer () - "Does nothing. -Stub for consistency with other hide-buffer functions." - nil) - (defun which-key--hide-buffer-side-window () "Hide which-key buffer when side-window popup is used." (when (buffer-live-p which-key--buffer) @@ -523,16 +519,12 @@ 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 - (minibuffer (which-key--show-buffer-minibuffer act-popup-dim)) + ;; 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--show-buffer-minibuffer (act-popup-dim) - "Does nothing. -Stub for consistency with other show-buffer functions." - nil) - (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 commit 2fd3464866aac81ff792f8c2821d99be08291e3c Author: Justin Burkett Date: Wed Jul 22 12:43:45 2015 -0400 Tweak next-page timer diff --git a/which-key.el b/which-key.el index 897eacb2096..c2c89abc296 100644 --- a/which-key.el +++ b/which-key.el @@ -993,7 +993,7 @@ enough space based on your settings and frame size." prefix-keys) (which-key--show-page next-page) (let (timer) (setq timer - (run-with-idle-timer 0.1 t + (run-with-idle-timer 0.2 t (lambda () (when (or (not (eq real-last-command 'which-key-show-next-page)) (and (< 0 (length (this-single-command-keys))) commit a693a4931cda8787a185941ee74f0e8c1f977945 Author: Justin Burkett Date: Wed Jul 22 12:30:48 2015 -0400 Fix for #49 Need to check if the prefix has changed when possibly restarting the timer after paging. diff --git a/which-key.el b/which-key.el index f58a88abf94..897eacb2096 100644 --- a/which-key.el +++ b/which-key.el @@ -995,7 +995,10 @@ enough space based on your settings and frame size." prefix-keys) (setq timer (run-with-idle-timer 0.1 t (lambda () - (unless (eq real-last-command 'which-key-show-next-page) + (when (or (not (eq real-last-command 'which-key-show-next-page)) + (and (< 0 (length (this-single-command-keys))) + (not (equal which-key--current-prefix + (this-single-command-keys))))) (cancel-timer timer) (which-key--start-timer)))))))) commit 945249f2ee26472e45814dafa0b5bf980c0035f3 Author: Justin Burkett Date: Wed Jul 22 10:47:07 2015 -0400 Fix #50 - Don't show pages if only 1 page diff --git a/which-key.el b/which-key.el index 0964defe89e..f58a88abf94 100644 --- a/which-key.el +++ b/which-key.el @@ -956,13 +956,24 @@ enough space based on your settings and frame size." prefix-keys) (prefix-left (s-pad-right first-col-width " " prefix-w-face)) (status-left (s-pad-right first-col-width " " status-left)) new-end lines) - (cond ((eq which-key-show-prefix 'left) + (cond ((and (< 1 n-pages) + (eq which-key-show-prefix 'left)) (setq lines (split-string page "\n") first (concat prefix-left (car lines) "\n" status-left) new-end (concat "\n" (s-repeat first-col-width " ")) page (concat first (mapconcat #'identity (cdr lines) new-end)))) + ((eq which-key-show-prefix 'left) + (if (= 1 height) + (setq page (concat prefix-left page)) + (setq lines (split-string page "\n") + first (concat prefix-left (car lines) "\n" (s-repeat first-col-width " ")) + new-end (concat "\n" (s-repeat first-col-width " ")) + page (concat first (mapconcat #'identity (cdr lines) new-end))))) + ((and (< 1 n-pages) + (eq which-key-show-prefix 'top)) + (setq page (concat prefix-w-face "- " status-top "\n" page))) ((eq which-key-show-prefix 'top) - (setq page (concat prefix-w-face "- " status-top "\n" page)))) + (setq page (concat prefix-w-face "- \n" page)))) (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" page)) commit e1b9e7f25e82a5b5b7f8a5219b12fc24497d6dcf Author: Justin Burkett Date: Wed Jul 22 08:58:45 2015 -0400 No need to call show-popup for minibuffer diff --git a/which-key.el b/which-key.el index ac2eaa62b45..0964defe89e 100644 --- a/which-key.el +++ b/which-key.el @@ -969,8 +969,8 @@ enough space based on your settings and frame size." prefix-keys) (with-current-buffer which-key--buffer (erase-buffer) (insert page) - (goto-char (point-min)))) - (which-key--show-popup (cons height width)))))) + (goto-char (point-min))) + (which-key--show-popup (cons height width))))))) (defun which-key-show-next-page () "Show the next page of keys." commit 7a30c1e5274e2b6e527a4891c136acfd4e9b075f Author: Justin Burkett Date: Wed Jul 22 08:29:22 2015 -0400 Use real-last-command instead of last-command for which-key-show-next-page diff --git a/which-key.el b/which-key.el index e128302dcf8..ac2eaa62b45 100644 --- a/which-key.el +++ b/which-key.el @@ -984,7 +984,7 @@ enough space based on your settings and frame size." prefix-keys) (setq timer (run-with-idle-timer 0.1 t (lambda () - (when (not (eq last-command 'which-key-show-next-page)) + (unless (eq real-last-command 'which-key-show-next-page) (cancel-timer timer) (which-key--start-timer)))))))) commit 060e2a2329b4d8f30a545ae3d4d519f6d1b7cf61 Author: Justin Burkett Date: Tue Jul 21 21:21:45 2015 -0400 Fix a default regexp diff --git a/README.org b/README.org index d282a94a48a..26a507f47da 100644 --- a/README.org +++ b/README.org @@ -252,7 +252,7 @@ descriptions directly. The relevant variables are Here's an example of one of the default key replacements #+BEGIN_SRC emacs-lisp -("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") +("<\\([[:alnum:]-]+\\)>" . "\\1") #+END_SRC The =car= takes a string which may use emacs regexp and the =cdr= takes a string diff --git a/which-key.el b/which-key.el index 865712e4caa..e128302dcf8 100644 --- a/which-key.el +++ b/which-key.el @@ -79,7 +79,7 @@ of the which-key popup." :type 'integer) (defcustom which-key-key-replacement-alist - '(("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") ("left" . "←") ("right" . "→")) + '(("<\\([[:alnum:]-]+\\)>" . "\\1") ("left" . "←") ("right" . "→")) "The strings in the car of each cons are replaced with the strings in the cdr for each key. Elisp regexp can be used as in the first example." commit ba74099ba1d298c0d46e4de3f690f3f4564c72cd Author: Justin Burkett Date: Tue Jul 21 21:13:00 2015 -0400 Fix sort order in readme again diff --git a/README.org b/README.org index 9f23c34cf41..d282a94a48a 100644 --- a/README.org +++ b/README.org @@ -275,7 +275,7 @@ 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, RET, ...) < Single Character (a, b, ...) < Modifier (C-, M-, ...) < Other= +=Special (SPC, TAB, ...) < Single Character (a, ...) < Modifier (C-, M-, ...) < Other= You can control the order by setting this variable. commit bd7eb9ee637e2041c0bfbec4677b5aacda3068a1 Author: Justin Burkett Date: Tue Jul 21 21:11:57 2015 -0400 Fix latex in readme diff --git a/README.org b/README.org index 0d3b70016ab..9f23c34cf41 100644 --- a/README.org +++ b/README.org @@ -275,7 +275,7 @@ 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, RET, \ldots) < Single Character (a, b, \ldots) < Modifier (C-, M-, \ldots) < Other +=Special (SPC, TAB, RET, ...) < Single Character (a, b, ...) < Modifier (C-, M-, ...) < Other= You can control the order by setting this variable. commit 57980fb2bf01f99a0a60a47938fab2d46d6157d3 Author: Justin Burkett Date: Tue Jul 21 21:09:29 2015 -0400 Move paging defcustoms diff --git a/which-key.el b/which-key.el index e30e9001197..865712e4caa 100644 --- a/which-key.el +++ b/which-key.el @@ -189,6 +189,17 @@ description." :group 'which-key :type 'function) +(defcustom which-key-paging-prefixes '() + "Enable paging for these prefixes." + :group 'which-key + :type '(repeat string)) + +(defcustom which-key-paging-key "" + "Key to use for changing pages. Bound after each of the +prefixes in `which-key-paging-prefixes'" + :group 'which-key + :type 'string) + ;; Faces (defface which-key-key-face '((t . (:inherit font-lock-constant-face))) @@ -238,17 +249,6 @@ ignored." :group 'which-key :type 'function) -(defcustom which-key-paging-prefixes '() - "Enable paging for these prefixes." - :group 'which-key - :type '(repeat string)) - -(defcustom which-key-paging-key "" - "Key to use for changing pages. Bound after each of the -prefixes in `which-key-paging-prefixes'" - :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 commit 0159ec37ce3ca4346f7e2b550cd2936ff85f02dd Author: Justin Burkett Date: Tue Jul 21 21:09:06 2015 -0400 Update readme with new features diff --git a/README.org b/README.org index fa85454185a..0d3b70016ab 100644 --- a/README.org +++ b/README.org @@ -21,6 +21,8 @@ following features: 5. A well configured back-end for displaying keys (removing the popwin dependency) that can be easily customized by writing new display functions +Many of these have been implemented and are described below. + ** Table of Contents :TOC@4: - [[#which-key-][which-key ]] - [[#introduction][Introduction]] @@ -31,6 +33,7 @@ following features: - [[#minibuffer-option][Minibuffer Option]] - [[#side-window-right-option][Side Window Right Option]] - [[#side-window-bottom-option][Side Window Bottom Option]] + - [[#side-window-right-then-bottom][Side Window Right then Bottom]] - [[#special-features-and-configuration-options][Special Features and Configuration Options]] - [[#several-popup-types][Several Popup Types]] - [[#minibuffer][minibuffer]] @@ -40,6 +43,10 @@ following features: - [[#custom-string-replacement][Custom String Replacement]] - [[#key-based-replacement]["Key-Based" replacement]] - [[#key-and-description-replacement][Key and Description replacement]] + - [[#sorting][Sorting]] + - [[#paging][Paging]] + - [[#other-options][Other Options]] + - [[#more-examples][More Examples]] - [[#nice-display-with-split-frame][Nice Display with Split Frame]] - [[#status][Status]] - [[#thanks][Thanks]] @@ -47,7 +54,8 @@ following features: ** Install *** MELPA After setting up [[http://melpa.org][MELPA]] as a repository, use =M-x package-install which-key= or -your preferred method. +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 @@ -115,6 +123,15 @@ Popup side window on bottom. For defaults use [[./img/which-key-bottom.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. + +#+BEGIN_SRC emacs-lisp +(which-key-setup-side-window-right-bottom) +#+END_SRC + ** 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=. @@ -133,7 +150,10 @@ Show keys in the minibuffer. #+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 +;; 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. @@ -225,6 +245,7 @@ There are two helper functions to add entries to this list, directly or use these. **** Key and Description replacement + The second and third methods target the text used for the keys and the descriptions directly. The relevant variables are =which-key-key-replacement-alist= and =which-key-description-replacement-alist=. @@ -249,6 +270,80 @@ these alists) (add-to-list 'which-key-key-replacement-alist '("left" . "lft")) #+END_SRC +*** Sorting +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, RET, \ldots) < Single Character (a, b, \ldots) < Modifier (C-, M-, \ldots) < Other + +You can control the order by setting this variable. + +#+BEGIN_SRC emacs-lisp +(setq which-key-sort-order 'which-key-key-order) +;; or (setq which-key-sort-order 'which-key-description-order) +#+END_SRC + +The only other built-in option at the moment (besides using nil to turn off +sorting completely) is =which-key-description-order=, which orders by the key's +description based on the usual ordering of strings after applying =downcase=. + +*** Paging +This is a new feature and may have bugs, so it is disabled by default. 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-show-next-page= which will cycle through +the pages without changing the key sequence you were in the middle of typing. +Essentially, all you need to do to enable this for a prefix like =C-x= is the +following which will bind == to the command. + +#+BEGIN_SRC emacs-lisp +(define-key which-key-mode-map (kbd "C-x ") 'which-key-show-next-page) +#+END_SRC + +This is completely equivalent to + +#+BEGIN_SRC emacs-lisp +(setq which-key-paging-prefixes '("C-x")) +(setq which-key-paging-key "") +#+END_SRC + +where the latter are provided for convenience if you have a lot of prefixes. + +*** 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. + (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) + + ;; 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 special keys. These are automatically truncated to one character + ;; and have which-key-special-key-face applied. + (setq which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL")) + + ;; Show the key prefix on the left or top (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 +** More Examples *** Nice Display with Split Frame Unlike guide-key, which-key looks good even if the frame is split into several windows. commit ee6d75e52b06c488883d367486061c2e5a28f4bf Author: Justin Burkett Date: Tue Jul 21 16:02:30 2015 -0400 Much better paging implementation diff --git a/which-key.el b/which-key.el index 855d08871bf..e30e9001197 100644 --- a/which-key.el +++ b/which-key.el @@ -261,7 +261,7 @@ to a non-nil value for the execution of a command. Like this "Internal: Holds reference to which-key buffer.") (defvar which-key--window nil "Internal: Holds reference to which-key window.") -(defvar which-key--open-timer nil +(defvar which-key--timer nil "Internal: Holds reference to open window timer.") (defvar which-key--is-setup nil "Internal: Non-nil if which-key buffer has been setup.") @@ -276,9 +276,7 @@ Used when `which-key-popup-type' is frame.") "Internal: Holds lighter backup") (defvar which-key--current-prefix nil "Internal: Holds current prefix") -(defvar which-key--last-prefix nil) (defvar which-key--current-page-n nil) -(defvar which-key--request-page nil) ;;;###autoload (define-minor-mode which-key-mode @@ -297,16 +295,16 @@ Used when `which-key-popup-type' is frame.") which-key-paging-prefixes) (add-hook 'pre-command-hook #'which-key--hide-popup) (add-hook 'pre-command-hook #'which-key--lighter-restore) - (add-hook 'focus-out-hook #'which-key--stop-open-timer) - (add-hook 'focus-in-hook #'which-key--start-open-timer) - (which-key--start-open-timer)) + (add-hook 'focus-out-hook #'which-key--stop-timer) + (add-hook 'focus-in-hook #'which-key--start-timer) + (which-key--start-timer)) ;; make sure echo-keystrokes returns to original value (setq echo-keystrokes which-key--echo-keystrokes-backup) (remove-hook 'pre-command-hook #'which-key--hide-popup) (remove-hook 'pre-command-hook #'which-key--lighter-restore) - (remove-hook 'focus-out-hook #'which-key--stop-open-timer) - (remove-hook 'focus-in-hook #'which-key--start-open-timer) - (which-key--stop-open-timer))) + (remove-hook 'focus-out-hook #'which-key--stop-timer) + (remove-hook 'focus-in-hook #'which-key--start-timer) + (which-key--stop-timer))) (defun which-key--setup () "Initial setup for which-key. @@ -979,13 +977,16 @@ enough space based on your settings and frame size." prefix-keys) (interactive) (let ((next-page (if which-key--current-page-n (1+ which-key--current-page-n) 0))) - (setq which-key--request-page next-page) - (setq unread-command-events (listify-key-sequence which-key--current-prefix)))) - -;; (setq map (make-sparse-keymap)) -;; (define-key map (kbd "C-M-1") (lambda () (interactive) (which-key--show-page 0))) -;; (define-key map (kbd "C-M-2") (lambda () (interactive) (which-key--show-page 1))) -;; (evil-leader/set-key "" 'which-key-show-next-page) + (which-key--stop-timer) + (setq unread-command-events (listify-key-sequence which-key--current-prefix)) + (which-key--show-page next-page) + (let (timer) + (setq timer + (run-with-idle-timer 0.1 t + (lambda () + (when (not (eq last-command 'which-key-show-next-page)) + (cancel-timer timer) + (which-key--start-timer)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update @@ -1021,12 +1022,7 @@ Finally, show the buffer." (keymapp (lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) (let ((page-n 0)) - (if which-key--request-page - (progn - (setq page-n which-key--request-page - which-key--request-page nil)) - (setq which-key--last-prefix which-key--current-prefix - which-key--current-prefix prefix-keys)) + (setq which-key--current-prefix prefix-keys) (let ((formatted-keys (which-key--get-formatted-key-bindings (current-buffer))) (prefix-keys-desc (key-description prefix-keys)) @@ -1041,15 +1037,15 @@ Finally, show the buffer." ;; Timers -(defun which-key--start-open-timer () +(defun which-key--start-timer () "Activate idle timer to trigger `which-key--update'." - (which-key--stop-open-timer) ; start over - (setq which-key--open-timer + (which-key--stop-timer) ; start over + (setq which-key--timer (run-with-idle-timer which-key-idle-delay t 'which-key--update))) -(defun which-key--stop-open-timer () +(defun which-key--stop-timer () "Deactivate idle timer for `which-key--update'." - (when which-key--open-timer (cancel-timer which-key--open-timer))) + (when which-key--timer (cancel-timer which-key--timer))) ;; TODO commit b811fcc11dd2a98160ccec56a1aaa71956481686 Author: Justin Burkett Date: Tue Jul 21 12:47:48 2015 -0400 Don't prevent changing paging bindings diff --git a/which-key.el b/which-key.el index c347f6b4c5f..855d08871bf 100644 --- a/which-key.el +++ b/which-key.el @@ -289,6 +289,12 @@ Used when `which-key-popup-type' is frame.") (if which-key-mode (progn (unless which-key--is-setup (which-key--setup)) + ;; bind keys for paging + (mapc (lambda (prefix) + (define-key which-key-mode-map + (kbd (concat prefix " " which-key-paging-key)) + 'which-key-show-next-page)) + which-key-paging-prefixes) (add-hook 'pre-command-hook #'which-key--hide-popup) (add-hook 'pre-command-hook #'which-key--lighter-restore) (add-hook 'focus-out-hook #'which-key--stop-open-timer) @@ -308,11 +314,6 @@ Reduce `echo-keystrokes' if necessary (it will interfer if it's set too high) and setup which-key buffer." (when (eq which-key-popup-type 'minibuffer) (which-key--setup-echo-keystrokes)) - (mapc (lambda (prefix) - (define-key which-key-mode-map - (kbd (concat prefix " " which-key-paging-key)) - 'which-key-show-next-page)) - which-key-paging-prefixes) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer ;; suppress confusing minibuffer message commit 481b0b36930121f72937dfae3e28c245a1d6c982 Author: Justin Burkett Date: Tue Jul 21 12:43:41 2015 -0400 Add options for paging (disabled by default) diff --git a/which-key.el b/which-key.el index b46a2a27070..c347f6b4c5f 100644 --- a/which-key.el +++ b/which-key.el @@ -238,6 +238,17 @@ ignored." :group 'which-key :type 'function) +(defcustom which-key-paging-prefixes '() + "Enable paging for these prefixes." + :group 'which-key + :type '(repeat string)) + +(defcustom which-key-paging-key "" + "Key to use for changing pages. Bound after each of the +prefixes in `which-key-paging-prefixes'" + :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 @@ -274,6 +285,7 @@ Used when `which-key-popup-type' is frame.") "Toggle which-key-mode." :global t :lighter " WK" + :keymap '() (if which-key-mode (progn (unless which-key--is-setup (which-key--setup)) @@ -296,6 +308,11 @@ Reduce `echo-keystrokes' if necessary (it will interfer if it's set too high) and setup which-key buffer." (when (eq which-key-popup-type 'minibuffer) (which-key--setup-echo-keystrokes)) + (mapc (lambda (prefix) + (define-key which-key-mode-map + (kbd (concat prefix " " which-key-paging-key)) + 'which-key-show-next-page)) + which-key-paging-prefixes) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer ;; suppress confusing minibuffer message @@ -959,8 +976,10 @@ enough space based on your settings and frame size." prefix-keys) (defun which-key-show-next-page () "Show the next page of keys." (interactive) - (setq which-key--request-page (1+ which-key--current-page-n)) - (setq unread-command-events (listify-key-sequence which-key--last-prefix))) + (let ((next-page (if which-key--current-page-n + (1+ which-key--current-page-n) 0))) + (setq which-key--request-page next-page) + (setq unread-command-events (listify-key-sequence which-key--current-prefix)))) ;; (setq map (make-sparse-keymap)) ;; (define-key map (kbd "C-M-1") (lambda () (interactive) (which-key--show-page 0))) commit b945808fc033f4164dd549349c3681b2bea017e0 Author: Justin Burkett Date: Tue Jul 21 10:11:34 2015 -0400 Fix readme diff --git a/README.org b/README.org index 5ece31c1457..fa85454185a 100644 --- a/README.org +++ b/README.org @@ -1,10 +1,5 @@ -<<<<<<< HEAD -[[http://melpa.org/packages/which-key-badge.svg]] -* which-key -======= * which-key [[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]] ->>>>>>> master ** Introduction =which-key= is a minor mode for Emacs that displays the keybindings following your currently entered incomplete command (a prefix) in a popup. For example, after enabling the minor mode commit 74989c944ab0d955e80a5e135a576653377f5ae1 Author: Justin Burkett Date: Tue Jul 21 10:09:37 2015 -0400 Add check for no keys diff --git a/which-key.el b/which-key.el index 059b7ea82bd..b46a2a27070 100644 --- a/which-key.el +++ b/which-key.el @@ -921,8 +921,8 @@ element in each list element of KEYS." (let ((n-pages (plist-get which-key--pages-plist :n-pages)) (prefix-keys (key-description which-key--current-prefix))) (if (= 0 n-pages) - (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." - prefix-keys) + (message "%s- which-key can't show keys: There is not \ +enough space based on your settings and frame size." prefix-keys) (setq which-key--current-page-n n) (let* ((i (mod n n-pages)) (page (nth i (plist-get which-key--pages-plist :pages))) @@ -1011,11 +1011,13 @@ Finally, show the buffer." (current-buffer))) (prefix-keys-desc (key-description prefix-keys)) pages-right pages-bottom) - (if (listp which-key-side-window-location) - (apply #'which-key--try-2-side-windows page-n which-key-side-window-location) - (setq which-key--pages-plist (which-key--create-pages formatted-keys - (window-width))) - (which-key--show-page page-n))))))) + (cond ((= (length formatted-keys) 0) + (message "%s- which-key: There are no keys to show" prefix-keys-desc)) + ((listp which-key-side-window-location) + (apply #'which-key--try-2-side-windows page-n which-key-side-window-location)) + (t (setq which-key--pages-plist + (which-key--create-pages formatted-keys (window-width))) + (which-key--show-page page-n)))))))) ;; Timers commit 59800730e6b149c75d2b1d218ee01f536c1f7fec Author: Justin Burkett Date: Tue Jul 21 09:49:13 2015 -0400 Add new setup function for right-bottom diff --git a/which-key.el b/which-key.el index 099efefec39..059b7ea82bd 100644 --- a/which-key.el +++ b/which-key.el @@ -332,6 +332,13 @@ it's set too high)." which-key-side-window-location 'right which-key-show-prefix 'top)) +(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 @@ -926,7 +933,7 @@ element in each list element of KEYS." (prefix-w-face (which-key--propertize-key prefix-keys)) (status-left (propertize (format "%s/%s" (1+ i) n-pages) 'face 'font-lock-comment-face)) - (status-top (propertize (format "[%s/%s]" (1+ i) n-pages) + (status-top (propertize (format "(%s of %s)" (1+ i) n-pages) 'face 'font-lock-comment-face)) (first-col-width (+ 2 (max (string-width prefix-w-face) (string-width status-left)))) commit c44b9157b5f5c637cffd3a6c12e179e49b04651b Author: Justin Burkett Date: Tue Jul 21 09:44:18 2015 -0400 Bump version diff --git a/which-key.el b/which-key.el index ec3c8299d5c..099efefec39 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.2.1 +;; Version: 0.3 ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) commit bd38bf9ea29f900154f7fd8829cd8e949b5565ac Author: Justin Burkett Date: Tue Jul 21 09:41:53 2015 -0400 Turn off show remaining keys by default diff --git a/which-key.el b/which-key.el index 3b1d1cbbbb3..ec3c8299d5c 100644 --- a/which-key.el +++ b/which-key.el @@ -176,7 +176,7 @@ a percentage out of the frame's height." :group 'which-key :type 'integer) -(defcustom which-key-show-remaining-keys t +(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) @@ -958,7 +958,7 @@ element in each list element of KEYS." ;; (setq map (make-sparse-keymap)) ;; (define-key map (kbd "C-M-1") (lambda () (interactive) (which-key--show-page 0))) ;; (define-key map (kbd "C-M-2") (lambda () (interactive) (which-key--show-page 1))) -(evil-leader/set-key "" 'which-key-show-next-page) +;; (evil-leader/set-key "" 'which-key-show-next-page) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update commit 1b58c430f17bd062e88f61d122f1ddb4b9cc056b Merge: 45d6eb6f4f0 c7af70a1cc6 Author: Justin Burkett Date: Tue Jul 21 09:40:10 2015 -0400 Merge branch 'develop' commit c7af70a1cc6d241ad228c2746a204732391de71b Author: Justin Burkett Date: Tue Jul 21 09:05:08 2015 -0400 Basic paging works diff --git a/which-key.el b/which-key.el index 5d3ac667ea7..3b1d1cbbbb3 100644 --- a/which-key.el +++ b/which-key.el @@ -263,6 +263,11 @@ Used when `which-key-popup-type' is frame.") "Internal: Holds page objects") (defvar which-key--lighter-backup nil "Internal: Holds lighter backup") +(defvar which-key--current-prefix nil + "Internal: Holds current prefix") +(defvar which-key--last-prefix nil) +(defvar which-key--current-page-n nil) +(defvar which-key--request-page nil) ;;;###autoload (define-minor-mode which-key-mode @@ -728,7 +733,7 @@ removing a \"group:\" prefix." 'which-key-group-description-face 'which-key-command-description-face)))) -(defun which-key--format-and-replace (unformatted prefix-keys) +(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)." @@ -739,7 +744,7 @@ alists. Returns a list (key separator description)." (let* ((key (car key-desc-cons)) (desc (cdr key-desc-cons)) (group (which-key--group-p desc)) - (keys (concat prefix-keys " " key)) + (keys (concat (key-description which-key--current-prefix) " " key)) (key (which-key--maybe-replace key which-key-key-replacement-alist)) (desc (which-key--maybe-replace @@ -789,14 +794,14 @@ special (SPC,TAB,...) < single char < mod (C-,M-,...) < other." Uses `string-lessp' after applying lowercase." (string-lessp (downcase (cdr alst)) (downcase (cdr blst)))) -(defun which-key--get-formatted-key-bindings (buffer key-seq) +(defun which-key--get-formatted-key-bindings (buffer) "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." - (let ((key-str-qt (regexp-quote (key-description key-seq))) + (let ((key-str-qt (regexp-quote (key-description which-key--current-prefix))) key-match desc-match unformatted format-res formatted column-width) (with-temp-buffer - (describe-buffer-bindings buffer key-seq) + (describe-buffer-bindings buffer which-key--current-prefix) (goto-char (point-max)) ; want to put last keys in first (while (re-search-backward (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" @@ -809,7 +814,7 @@ BUFFER that follow the key sequence KEY-SEQ." (when which-key-sort-order (setq unformatted (sort unformatted (lambda (a b) (funcall which-key-sort-order a b))))) - (which-key--format-and-replace unformatted (key-description key-seq)))) + (which-key--format-and-replace unformatted))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for laying out which-key buffer pages @@ -848,17 +853,17 @@ element in each list element of KEYS." ;; give up if first column doesn't fit (list :pages nil :page-height 0 :page-widths '(0) :keys/page '(0) :n-pages 0 :tot-keys 0) - (dolist (col cols-w-widths) - (if (<= (+ (car col) page-width) avl-width) - (progn (push (cdr col) page-cols) - (setq page-width (+ page-width (car col)))) - (when (> (length page-cols) 0) - (push (which-key--join-columns page-cols) pages) - (push (* (length page-cols) avl-lines) keys/page) - (push page-width page-widths) - (setq n-pages (1+ n-pages) - page-cols (list (cdr col)) - page-width (car col))))) + (dolist (col cols-w-widths) + (if (<= (+ (car col) page-width) avl-width) + (progn (push (cdr col) page-cols) + (setq page-width (+ page-width (car col)))) + (when (> (length page-cols) 0) + (push (which-key--join-columns page-cols) pages) + (push (* (length page-cols) avl-lines) keys/page) + (push page-width page-widths) + (setq n-pages (1+ n-pages) + page-cols (list (cdr col)) + page-width (car col))))) (when (> (length page-cols) 0) (push (which-key--join-columns page-cols) pages) (push (* (length page-cols) avl-lines) keys/page) @@ -869,11 +874,12 @@ element in each list element of KEYS." :keys/page (reverse keys/page) :n-pages n-pages :tot-keys (cl-reduce '+ keys/page :initial-value 0))))) -(defun which-key--create-pages (prefix-keys keys sel-win-width) +(defun which-key--create-pages (keys sel-win-width) (let* ((max-dims (which-key--popup-max-dimensions sel-win-width)) (max-lines (car max-dims)) (max-width (cdr max-dims)) - (prefix-w-face (which-key--propertize-key prefix-keys)) + (prefix-keys-desc (key-description which-key--current-prefix)) + (prefix-w-face (which-key--propertize-key prefix-keys-desc)) (prefix-left (when (eq which-key-show-prefix 'left) (+ 2 (string-width prefix-w-face)))) (prefix-top (eq which-key-show-prefix 'top)) @@ -883,7 +889,6 @@ element in each list element of KEYS." (member which-key-side-window-location '(left right)))) (result (which-key--partition-columns keys avl-lines avl-width)) pages keys/page n-pages found prev-result) - (setq int result) (cond ((or vertical (> (plist-get result :n-pages) 1) (= 1 avl-lines)) result) ;; do a simple search for the smallest number of lines @@ -904,15 +909,14 @@ element in each list element of KEYS." (when which-key-show-remaining-keys (setcar (cdr (assq 'which-key-mode minor-mode-alist)) which-key--lighter-backup))) -(defun which-key--show-page (n &optional prefix-keys) - "Show page N, starting from 0. -PREFIX-KEYS holds the description of the prefix keys." - (let ((n-pages (plist-get which-key--pages-plist :n-pages))) +(defun which-key--show-page (n) + "Show page N, starting from 0." + (let ((n-pages (plist-get which-key--pages-plist :n-pages)) + (prefix-keys (key-description which-key--current-prefix))) (if (= 0 n-pages) - (if prefix-keys - (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." - prefix-keys) - (message "which-key can't show keys: Settings and/or frame size are too restrictive.")) + (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." + prefix-keys) + (setq which-key--current-page-n n) (let* ((i (mod n n-pages)) (page (nth i (plist-get which-key--pages-plist :pages))) (height (plist-get which-key--pages-plist :page-height)) @@ -945,29 +949,33 @@ PREFIX-KEYS holds the description of the prefix keys." (goto-char (point-min)))) (which-key--show-popup (cons height width)))))) +(defun which-key-show-next-page () + "Show the next page of keys." + (interactive) + (setq which-key--request-page (1+ which-key--current-page-n)) + (setq unread-command-events (listify-key-sequence which-key--last-prefix))) + ;; (setq map (make-sparse-keymap)) ;; (define-key map (kbd "C-M-1") (lambda () (interactive) (which-key--show-page 0))) ;; (define-key map (kbd "C-M-2") (lambda () (interactive) (which-key--show-page 1))) +(evil-leader/set-key "" 'which-key-show-next-page) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update -(defun which-key--try-2-side-windows (loc1 loc2) +(defun which-key--try-2-side-windows (page-n loc1 loc2) (let (pages1 pages2) (let ((which-key-side-window-location loc1)) - (setq pages1 (which-key--create-pages - prefix-keys-desc formatted-keys - (window-width)))) + (setq pages1 (which-key--create-pages formatted-keys (window-width)))) (if (< 0 (plist-get pages1 :n-pages)) (progn (setq which-key--pages-plist pages1) (let ((which-key-side-window-location loc1)) - (which-key--show-page 0 prefix-keys-desc))) + (which-key--show-page page-n))) (let ((which-key-side-window-location loc2)) (setq which-key--pages-plist (which-key--create-pages - prefix-keys-desc formatted-keys - (window-width))) - (which-key--show-page 0 prefix-keys-desc))))) + formatted-keys (window-width))) + (which-key--show-page page-n))))) (defun which-key--update () "Fill `which-key--buffer' with key descriptions and reformat. @@ -985,16 +993,22 @@ Finally, show the buffer." ;; just in case someone uses one of these (keymapp (lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) - (let ((formatted-keys (which-key--get-formatted-key-bindings - (current-buffer) prefix-keys)) - (prefix-keys-desc (key-description prefix-keys)) - pages-right pages-bottom) - (if (listp which-key-side-window-location) - (apply #'which-key--try-2-side-windows which-key-side-window-location) - (setq which-key--pages-plist (which-key--create-pages - prefix-keys-desc formatted-keys - (window-width))) - (which-key--show-page 0 prefix-keys-desc)))))) + (let ((page-n 0)) + (if which-key--request-page + (progn + (setq page-n which-key--request-page + which-key--request-page nil)) + (setq which-key--last-prefix which-key--current-prefix + which-key--current-prefix prefix-keys)) + (let ((formatted-keys (which-key--get-formatted-key-bindings + (current-buffer))) + (prefix-keys-desc (key-description prefix-keys)) + pages-right pages-bottom) + (if (listp which-key-side-window-location) + (apply #'which-key--try-2-side-windows page-n which-key-side-window-location) + (setq which-key--pages-plist (which-key--create-pages formatted-keys + (window-width))) + (which-key--show-page page-n))))))) ;; Timers commit d890188573f5efedeb2769753a64ac923f6269ef Author: Justin Burkett Date: Tue Jul 21 08:09:41 2015 -0400 Show page count with prefix diff --git a/which-key.el b/which-key.el index 05552b3315e..5d3ac667ea7 100644 --- a/which-key.el +++ b/which-key.el @@ -845,6 +845,7 @@ element in each list element of KEYS." (page-width 0) (n-pages 0) page-cols pages keys/page page-widths) (if (> (car (car cols-w-widths)) avl-width) + ;; give up if first column doesn't fit (list :pages nil :page-height 0 :page-widths '(0) :keys/page '(0) :n-pages 0 :tot-keys 0) (dolist (col cols-w-widths) @@ -919,15 +920,22 @@ PREFIX-KEYS holds the description of the prefix keys." (n-shown (nth i (plist-get which-key--pages-plist :keys/page))) (n-tot (plist-get which-key--pages-plist :tot-keys)) (prefix-w-face (which-key--propertize-key prefix-keys)) - (prefix-width (string-width prefix-w-face)) - spaces) + (status-left (propertize (format "%s/%s" (1+ i) n-pages) + 'face 'font-lock-comment-face)) + (status-top (propertize (format "[%s/%s]" (1+ i) n-pages) + 'face 'font-lock-comment-face)) + (first-col-width (+ 2 (max (string-width prefix-w-face) + (string-width status-left)))) + (prefix-left (s-pad-right first-col-width " " prefix-w-face)) + (status-left (s-pad-right first-col-width " " status-left)) + new-end lines) (cond ((eq which-key-show-prefix 'left) - (setq spaces (s-repeat prefix-width " ") - page (concat - prefix-w-face " " - (s-replace "\n" (concat "\n " spaces) page)))) + (setq lines (split-string page "\n") + first (concat prefix-left (car lines) "\n" status-left) + new-end (concat "\n" (s-repeat first-col-width " ")) + page (concat first (mapconcat #'identity (cdr lines) new-end)))) ((eq which-key-show-prefix 'top) - (setq page (concat prefix-w-face "-\n" page)))) + (setq page (concat prefix-w-face "- " status-top "\n" page)))) (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" page)) commit ee782ebfc52e5cae5b397473732cefcea3c5d8a8 Author: Justin Burkett Date: Mon Jul 20 16:02:30 2015 -0400 Put spaces in separator so they can be changed diff --git a/which-key.el b/which-key.el index c9b7aacdbaa..05552b3315e 100644 --- a/which-key.el +++ b/which-key.el @@ -57,7 +57,7 @@ Also adds \"..\"." :group 'which-key :type 'integer) -(defcustom which-key-separator "→" +(defcustom which-key-separator " → " "Separator to use between key and description." :group 'which-key :type 'string) @@ -830,12 +830,12 @@ element in each list element of KEYS." (let* ((col-key-width (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 (+ 3 col-key-width col-sep-width col-desc-width))) + (col-width (+ 1 col-key-width col-sep-width col-desc-width))) (cons col-width (mapcar (lambda (k) (concat (s-repeat (- col-key-width (string-width (nth 0 k))) " ") - (nth 0 k) " " (nth 1 k) " " (nth 2 k) + (nth 0 k) (nth 1 k) (nth 2 k) (s-repeat (- col-desc-width (string-width (nth 2 k))) " "))) col-keys)))) commit 765136acaf7697be37924693e5b3a563ee9e5f2f Author: Justin Burkett Date: Mon Jul 20 14:12:09 2015 -0400 Don't show page if first column doesn't fit diff --git a/which-key.el b/which-key.el index 972069a36b6..c9b7aacdbaa 100644 --- a/which-key.el +++ b/which-key.el @@ -844,26 +844,29 @@ element in each list element of KEYS." (-partition-all avl-lines keys))) (page-width 0) (n-pages 0) page-cols pages keys/page page-widths) - (dolist (col cols-w-widths) - (if (<= (+ (car col) page-width) avl-width) - (progn (push (cdr col) page-cols) - (setq page-width (+ page-width (car col)))) - (when (> (length page-cols) 0) - (push (which-key--join-columns page-cols) pages) - (push (* (length page-cols) avl-lines) keys/page) - (push page-width page-widths) - (setq n-pages (1+ n-pages) - page-cols (list (cdr col)) - page-width (car col))))) - (when (> (length page-cols) 0) - (push (which-key--join-columns page-cols) pages) - (push (* (length page-cols) avl-lines) keys/page) - (push page-width page-widths) - (setq n-pages (1+ n-pages))) - (list :pages (reverse pages) :page-height avl-lines - :page-widths (reverse page-widths) - :keys/page (reverse keys/page) :n-pages n-pages - :tot-keys (cl-reduce '+ keys/page :initial-value 0)))) + (if (> (car (car cols-w-widths)) avl-width) + (list :pages nil :page-height 0 :page-widths '(0) + :keys/page '(0) :n-pages 0 :tot-keys 0) + (dolist (col cols-w-widths) + (if (<= (+ (car col) page-width) avl-width) + (progn (push (cdr col) page-cols) + (setq page-width (+ page-width (car col)))) + (when (> (length page-cols) 0) + (push (which-key--join-columns page-cols) pages) + (push (* (length page-cols) avl-lines) keys/page) + (push page-width page-widths) + (setq n-pages (1+ n-pages) + page-cols (list (cdr col)) + page-width (car col))))) + (when (> (length page-cols) 0) + (push (which-key--join-columns page-cols) pages) + (push (* (length page-cols) avl-lines) keys/page) + (push page-width page-widths) + (setq n-pages (1+ n-pages))) + (list :pages (reverse pages) :page-height avl-lines + :page-widths (reverse page-widths) + :keys/page (reverse keys/page) :n-pages n-pages + :tot-keys (cl-reduce '+ keys/page :initial-value 0))))) (defun which-key--create-pages (prefix-keys keys sel-win-width) (let* ((max-dims (which-key--popup-max-dimensions sel-win-width)) commit 82ea3f8789aae440edc5e73b33ff31d4b013a987 Author: Justin Burkett Date: Mon Jul 20 14:05:42 2015 -0400 Fix bug in page layout Pages were getting dropped diff --git a/which-key.el b/which-key.el index cb855e98c23..972069a36b6 100644 --- a/which-key.el +++ b/which-key.el @@ -852,7 +852,9 @@ element in each list element of KEYS." (push (which-key--join-columns page-cols) pages) (push (* (length page-cols) avl-lines) keys/page) (push page-width page-widths) - (setq n-pages (1+ n-pages) page-cols '() page-width 0)))) + (setq n-pages (1+ n-pages) + page-cols (list (cdr col)) + page-width (car col))))) (when (> (length page-cols) 0) (push (which-key--join-columns page-cols) pages) (push (* (length page-cols) avl-lines) keys/page) @@ -877,6 +879,7 @@ element in each list element of KEYS." (member which-key-side-window-location '(left right)))) (result (which-key--partition-columns keys avl-lines avl-width)) pages keys/page n-pages found prev-result) + (setq int result) (cond ((or vertical (> (plist-get result :n-pages) 1) (= 1 avl-lines)) result) ;; do a simple search for the smallest number of lines commit 6adae6fd772f8894ca29318771668a0614f37487 Author: Justin Burkett Date: Mon Jul 20 13:53:25 2015 -0400 Ability to specify two locations for side-window diff --git a/which-key.el b/which-key.el index 7e1a4b0c34d..cb855e98c23 100644 --- a/which-key.el +++ b/which-key.el @@ -138,14 +138,17 @@ the feature off." (defcustom which-key-side-window-location 'right "Location of which-key popup when `which-key-popup-type' is side-window. -Should be one of top, bottom, left or right." +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))) + (const (right bottom)) + (const (bottom right)))) (defcustom which-key-side-window-max-width 0.333 "Maximum width of which-key popup when type is side-window and @@ -925,7 +928,7 @@ PREFIX-KEYS holds the description of the prefix keys." (with-current-buffer which-key--buffer (erase-buffer) (insert page) - (goto-char (point-max)))) + (goto-char (point-min)))) (which-key--show-popup (cons height width)))))) ;; (setq map (make-sparse-keymap)) @@ -935,6 +938,23 @@ PREFIX-KEYS holds the description of the prefix keys." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update +(defun which-key--try-2-side-windows (loc1 loc2) + (let (pages1 pages2) + (let ((which-key-side-window-location loc1)) + (setq pages1 (which-key--create-pages + prefix-keys-desc formatted-keys + (window-width)))) + (if (< 0 (plist-get pages1 :n-pages)) + (progn + (setq which-key--pages-plist pages1) + (let ((which-key-side-window-location loc1)) + (which-key--show-page 0 prefix-keys-desc))) + (let ((which-key-side-window-location loc2)) + (setq which-key--pages-plist (which-key--create-pages + prefix-keys-desc formatted-keys + (window-width))) + (which-key--show-page 0 prefix-keys-desc))))) + (defun which-key--update () "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." @@ -955,38 +975,12 @@ Finally, show the buffer." (current-buffer) prefix-keys)) (prefix-keys-desc (key-description prefix-keys)) pages-right pages-bottom) - (cond ((and (eq which-key-popup-type 'side-window) - (member which-key-side-window-location '(right-bottom bottom-right))) - (let ((which-key-side-window-location 'right)) - (setq pages-right (which-key--create-pages - prefix-keys-desc formatted-keys - (window-width)))) - (let ((which-key-side-window-location 'bottom)) - (setq pages-bottom (which-key--create-pages - prefix-keys-desc formatted-keys - (window-width)))) - (cond ((and (eq which-key-side-window-location 'right-bottom) - (< 0 (plist-get pages-right :n-pages))) - (setq which-key--pages-plist pages-right) - (let ((which-key-side-window-location 'right)) - (which-key--show-page 0 prefix-keys-desc))) - ((eq which-key-side-window-location 'right-bottom) - (setq which-key--pages-plist pages-bottom) - (let ((which-key-side-window-location 'bottom)) - (which-key--show-page 0 prefix-keys-desc))) - ((and (eq which-key-side-window-location 'bottom-right) - (< 0 (plist-get pages-bottom :n-pages))) - (setq which-key--pages-plist pages-bottom) - (let ((which-key-side-window-location 'bottom)) - (which-key--show-page 0 prefix-keys-desc))) - ((eq which-key-side-window-location 'bottom-right) - (setq which-key--pages-plist pages-bottom) - (let ((which-key-side-window-location 'bottom)) - (which-key--show-page 0 prefix-keys-desc))))) - (t (setq which-key--pages-plist (which-key--create-pages - prefix-keys-desc formatted-keys - (window-width))) - (which-key--show-page 0 prefix-keys-desc))))))) + (if (listp which-key-side-window-location) + (apply #'which-key--try-2-side-windows which-key-side-window-location) + (setq which-key--pages-plist (which-key--create-pages + prefix-keys-desc formatted-keys + (window-width))) + (which-key--show-page 0 prefix-keys-desc)))))) ;; Timers commit 4125bc6821c6b7836b434764c67decae0e50eb1c Author: Justin Burkett Date: Mon Jul 20 13:35:38 2015 -0400 echo-keystrokes might be nil diff --git a/which-key.el b/which-key.el index 5cf07b7aea0..7e1a4b0c34d 100644 --- a/which-key.el +++ b/which-key.el @@ -302,7 +302,8 @@ set too high) and setup which-key buffer." (defun which-key--setup-echo-keystrokes () "Reduce `echo-keystrokes' if necessary (it will interfer if it's set too high)." - (when (> (abs (- echo-keystrokes which-key-echo-keystrokes)) 0.000001) + (when (and echo-keystrokes + (> (abs (- echo-keystrokes which-key-echo-keystrokes)) 0.000001)) (setq which-key--echo-keystrokes-backup echo-keystrokes) (if (> which-key-idle-delay which-key-echo-keystrokes) (setq echo-keystrokes which-key-echo-keystrokes) commit a2401c8654d02718c1b986cad1667976ef5ba613 Author: Justin Burkett Date: Mon Jul 20 12:41:30 2015 -0400 Start on right-bottom and bottom-right sw impl diff --git a/which-key.el b/which-key.el index 2d05724a01f..5cf07b7aea0 100644 --- a/which-key.el +++ b/which-key.el @@ -143,7 +143,9 @@ Should be one of top, bottom, left or right." :type '(radio (const right) (const bottom) (const left) - (const top))) + (const top) + (const right-bottom) + (const bottom-right))) (defcustom which-key-side-window-max-width 0.333 "Maximum width of which-key popup when type is side-window and @@ -950,11 +952,40 @@ Finally, show the buffer." (not which-key-inhibit)) (let ((formatted-keys (which-key--get-formatted-key-bindings (current-buffer) prefix-keys)) - (prefix-keys-desc (key-description prefix-keys))) - (setq which-key--pages-plist (which-key--create-pages - prefix-keys-desc formatted-keys - (window-width))) - (which-key--show-page 0 prefix-keys-desc))))) + (prefix-keys-desc (key-description prefix-keys)) + pages-right pages-bottom) + (cond ((and (eq which-key-popup-type 'side-window) + (member which-key-side-window-location '(right-bottom bottom-right))) + (let ((which-key-side-window-location 'right)) + (setq pages-right (which-key--create-pages + prefix-keys-desc formatted-keys + (window-width)))) + (let ((which-key-side-window-location 'bottom)) + (setq pages-bottom (which-key--create-pages + prefix-keys-desc formatted-keys + (window-width)))) + (cond ((and (eq which-key-side-window-location 'right-bottom) + (< 0 (plist-get pages-right :n-pages))) + (setq which-key--pages-plist pages-right) + (let ((which-key-side-window-location 'right)) + (which-key--show-page 0 prefix-keys-desc))) + ((eq which-key-side-window-location 'right-bottom) + (setq which-key--pages-plist pages-bottom) + (let ((which-key-side-window-location 'bottom)) + (which-key--show-page 0 prefix-keys-desc))) + ((and (eq which-key-side-window-location 'bottom-right) + (< 0 (plist-get pages-bottom :n-pages))) + (setq which-key--pages-plist pages-bottom) + (let ((which-key-side-window-location 'bottom)) + (which-key--show-page 0 prefix-keys-desc))) + ((eq which-key-side-window-location 'bottom-right) + (setq which-key--pages-plist pages-bottom) + (let ((which-key-side-window-location 'bottom)) + (which-key--show-page 0 prefix-keys-desc))))) + (t (setq which-key--pages-plist (which-key--create-pages + prefix-keys-desc formatted-keys + (window-width))) + (which-key--show-page 0 prefix-keys-desc))))))) ;; Timers commit 3c2378db14d8030dc924ddedef82f2d7de3ae538 Author: Justin Burkett Date: Mon Jul 20 11:05:26 2015 -0400 Add description sort and make key order default diff --git a/which-key.el b/which-key.el index 7fc1ee93639..2d05724a01f 100644 --- a/which-key.el +++ b/which-key.el @@ -177,10 +177,12 @@ a percentage out of the frame's height." :type '(radio (const :tag "Yes" t) (const :tag "No" nil))) -(defcustom which-key-sort nil - "Sort output by `key-description' if non-nil." +(defcustom which-key-sort-order 'which-key-key-order + "If nil, leave output unsorted. Set to `which-key-key-order' to +order by key or `which-key-description-order' to order by +description." :group 'which-key - :type 'boolean) + :type 'function) ;; Faces (defface which-key-key-face @@ -743,11 +745,6 @@ alists. Returns a list (key separator description)." unformatted))) (defun which-key--key-description< (a b) - "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." (let* ((aem? (string-equal a "")) (bem? (string-equal b "")) (a1? (= 1 (length a))) @@ -773,6 +770,19 @@ special (SPC,TAB,...) < single char < mod (C-,M-,...) < other." ((or apr? bpr?) apr?) (t (string-lessp a b))))) +(defsubst which-key-key-order (alst blst) + "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 alst) (car blst))) + +(defsubst which-key-description-order (alst blst) + "Order descriptions of A and B. +Uses `string-lessp' after applying lowercase." + (string-lessp (downcase (cdr alst)) (downcase (cdr blst)))) + (defun which-key--get-formatted-key-bindings (buffer key-seq) "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." @@ -790,10 +800,9 @@ BUFFER that follow the key sequence KEY-SEQ." desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted :test (lambda (x y) (string-equal (car x) (car y)))))) - (when which-key-sort + (when which-key-sort-order (setq unformatted - (sort unformatted - (lambda (a b) (which-key--key-description< (car a) (car b)))))) + (sort unformatted (lambda (a b) (funcall which-key-sort-order a b))))) (which-key--format-and-replace unformatted (key-description key-seq)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; commit 9064b941ef197f453ecf867e1e921a259b0260d2 Author: Justin Burkett Date: Mon Jul 20 10:48:08 2015 -0400 Typo in lighter-status function diff --git a/which-key.el b/which-key.el index 75ef0e48230..7fc1ee93639 100644 --- a/which-key.el +++ b/which-key.el @@ -875,7 +875,7 @@ element in each list element of KEYS." (defun which-key--lighter-status (n-shown n-tot) (when which-key-show-remaining-keys - (setq which-key--lighter-backup (cdr (assq 'which-key-mode minor-mode-alist))) + (setq which-key--lighter-backup (cadr (assq 'which-key-mode minor-mode-alist))) (setcar (cdr (assq 'which-key-mode minor-mode-alist)) (format " WK: %s/%s keys" n-shown n-tot)))) (defun which-key--lighter-restore () commit 1a2ef54cc8d91c231df29383b23d36e993141ab2 Author: Justin Burkett Date: Mon Jul 20 08:43:59 2015 -0400 Fix mode line status diff --git a/which-key.el b/which-key.el index 45bd5d7ba10..75ef0e48230 100644 --- a/which-key.el +++ b/which-key.el @@ -846,7 +846,7 @@ element in each list element of KEYS." (list :pages (reverse pages) :page-height avl-lines :page-widths (reverse page-widths) :keys/page (reverse keys/page) :n-pages n-pages - :tot-keys (length keys)))) + :tot-keys (cl-reduce '+ keys/page :initial-value 0)))) (defun which-key--create-pages (prefix-keys keys sel-win-width) (let* ((max-dims (which-key--popup-max-dimensions sel-win-width)) @@ -874,11 +874,13 @@ element in each list element of KEYS." (if (and (> avl-lines 1) found) prev-result result))))) (defun which-key--lighter-status (n-shown n-tot) - (setq which-key--lighter-backup (cdr (assq 'which-key-mode minor-mode-alist))) - (setcar (cdr (assq 'which-key-mode minor-mode-alist)) - (format " WK: %s/%s keys" n-shown n-tot))) + (when which-key-show-remaining-keys + (setq which-key--lighter-backup (cdr (assq 'which-key-mode minor-mode-alist))) + (setcar (cdr (assq 'which-key-mode minor-mode-alist)) + (format " WK: %s/%s keys" n-shown n-tot)))) (defun which-key--lighter-restore () - (setcar (cdr (assq 'which-key-mode minor-mode-alist)) which-key--lighter-backup)) + (when which-key-show-remaining-keys + (setcar (cdr (assq 'which-key-mode minor-mode-alist)) which-key--lighter-backup))) (defun which-key--show-page (n &optional prefix-keys) "Show page N, starting from 0. @@ -905,8 +907,7 @@ PREFIX-KEYS holds the description of the prefix keys." (s-replace "\n" (concat "\n " spaces) page)))) ((eq which-key-show-prefix 'top) (setq page (concat prefix-w-face "-\n" page)))) - (when which-key-show-remaining-keys - (which-key--lighter-status n-shown n-tot)) + (which-key--lighter-status n-shown n-tot) (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" page)) (with-current-buffer which-key--buffer commit 3b1ee3b204ff4151753538c8dc5a974e358e8a8d Author: Justin Burkett Date: Mon Jul 20 08:22:21 2015 -0400 Add status to mode line diff --git a/which-key.el b/which-key.el index 59cc51e985a..45bd5d7ba10 100644 --- a/which-key.el +++ b/which-key.el @@ -254,6 +254,8 @@ Used when `which-key-popup-type' is frame.") "Internal: Backup the initial value of `echo-keystrokes'.") (defvar which-key--pages-plist nil "Internal: Holds page objects") +(defvar which-key--lighter-backup nil + "Internal: Holds lighter backup") ;;;###autoload (define-minor-mode which-key-mode @@ -264,12 +266,14 @@ Used when `which-key-popup-type' is frame.") (progn (unless which-key--is-setup (which-key--setup)) (add-hook 'pre-command-hook #'which-key--hide-popup) + (add-hook 'pre-command-hook #'which-key--lighter-restore) (add-hook 'focus-out-hook #'which-key--stop-open-timer) (add-hook 'focus-in-hook #'which-key--start-open-timer) (which-key--start-open-timer)) ;; make sure echo-keystrokes returns to original value (setq echo-keystrokes which-key--echo-keystrokes-backup) (remove-hook 'pre-command-hook #'which-key--hide-popup) + (remove-hook 'pre-command-hook #'which-key--lighter-restore) (remove-hook 'focus-out-hook #'which-key--stop-open-timer) (remove-hook 'focus-in-hook #'which-key--start-open-timer) (which-key--stop-open-timer))) @@ -841,7 +845,8 @@ element in each list element of KEYS." (setq n-pages (1+ n-pages))) (list :pages (reverse pages) :page-height avl-lines :page-widths (reverse page-widths) - :keys/page (reverse keys/page) :n-pages n-pages))) + :keys/page (reverse keys/page) :n-pages n-pages + :tot-keys (length keys)))) (defun which-key--create-pages (prefix-keys keys sel-win-width) (let* ((max-dims (which-key--popup-max-dimensions sel-win-width)) @@ -857,26 +862,23 @@ element in each list element of KEYS." (member which-key-side-window-location '(left right)))) (result (which-key--partition-columns keys avl-lines avl-width)) pages keys/page n-pages found prev-result) - (cond ;; ((and (> n-rem-keys 0) use-status-key) - ;; (setq status-key (propertize - ;; (format "%s keys not shown" (1+ n-rem-keys)) - ;; 'face 'font-lock-comment-face) - ;; first-try-str (plist-get first-try :str) - ;; first-try-str (substring - ;; first-try-str 0 - ;; (- (length first-try-str) - ;; (plist-get first-try :last-col-width)))) - ;; (plist-put first-try :str (concat first-try-str status-key))) - ((or vertical (> (plist-get result :n-pages) 1) (= 1 avl-lines)) - result) - ;; do a simple search for the smallest number of lines - (t (while (and (> avl-lines 1) (not found)) - (setq avl-lines (- avl-lines 1) - prev-result result - result (which-key--partition-columns - keys avl-lines avl-width) - found (> (plist-get result :n-pages) 1))) - (if (and (> avl-lines 1) found) prev-result result))))) + (cond ((or vertical (> (plist-get result :n-pages) 1) (= 1 avl-lines)) + result) + ;; do a simple search for the smallest number of lines + (t (while (and (> avl-lines 1) (not found)) + (setq avl-lines (- avl-lines 1) + prev-result result + result (which-key--partition-columns + keys avl-lines avl-width) + found (> (plist-get result :n-pages) 1))) + (if (and (> avl-lines 1) found) prev-result result))))) + +(defun which-key--lighter-status (n-shown n-tot) + (setq which-key--lighter-backup (cdr (assq 'which-key-mode minor-mode-alist))) + (setcar (cdr (assq 'which-key-mode minor-mode-alist)) + (format " WK: %s/%s keys" n-shown n-tot))) +(defun which-key--lighter-restore () + (setcar (cdr (assq 'which-key-mode minor-mode-alist)) which-key--lighter-backup)) (defun which-key--show-page (n &optional prefix-keys) "Show page N, starting from 0. @@ -891,6 +893,8 @@ PREFIX-KEYS holds the description of the prefix keys." (page (nth i (plist-get which-key--pages-plist :pages))) (height (plist-get which-key--pages-plist :page-height)) (width (nth i (plist-get which-key--pages-plist :page-widths))) + (n-shown (nth i (plist-get which-key--pages-plist :keys/page))) + (n-tot (plist-get which-key--pages-plist :tot-keys)) (prefix-w-face (which-key--propertize-key prefix-keys)) (prefix-width (string-width prefix-w-face)) spaces) @@ -901,6 +905,8 @@ PREFIX-KEYS holds the description of the prefix keys." (s-replace "\n" (concat "\n " spaces) page)))) ((eq which-key-show-prefix 'top) (setq page (concat prefix-w-face "-\n" page)))) + (when which-key-show-remaining-keys + (which-key--lighter-status n-shown n-tot)) (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" page)) (with-current-buffer which-key--buffer commit dd63f0a7600762dced5263a4d7109cba56e4ba55 Author: Justin Burkett Date: Mon Jul 20 00:04:11 2015 -0400 Move all prefix adding code to one place diff --git a/which-key.el b/which-key.el index 926b45668d9..59cc51e985a 100644 --- a/which-key.el +++ b/which-key.el @@ -820,14 +820,11 @@ element in each list element of KEYS." (s-repeat (- col-desc-width (string-width (nth 2 k))) " "))) col-keys)))) -(defun which-key--partition-columns (keys prefix-col avl-lines avl-width) +(defun which-key--partition-columns (keys avl-lines avl-width) (let ((cols-w-widths (mapcar #'which-key--pad-column (-partition-all avl-lines keys))) (page-width 0) (n-pages 0) page-cols pages keys/page page-widths) - (when (and prefix-col (<= (car prefix-col) avl-width)) - (push (cdr prefix-col) page-cols) - (setq page-width (car prefix-col))) (dolist (col cols-w-widths) (if (<= (+ (car col) page-width) avl-width) (progn (push (cdr col) page-cols) @@ -836,10 +833,7 @@ element in each list element of KEYS." (push (which-key--join-columns page-cols) pages) (push (* (length page-cols) avl-lines) keys/page) (push page-width page-widths) - (setq n-pages (1+ n-pages) page-cols '() page-width 0) - (when (and prefix-col (<= (car prefix-col) avl-width)) - (push (cdr prefix-col) page-cols) - (setq page-width (car prefix-col)))))) + (setq n-pages (1+ n-pages) page-cols '() page-width 0)))) (when (> (length page-cols) 0) (push (which-key--join-columns page-cols) pages) (push (* (length page-cols) avl-lines) keys/page) @@ -859,13 +853,9 @@ element in each list element of KEYS." (prefix-top (eq which-key-show-prefix 'top)) (avl-lines (if prefix-top (- max-lines 1) max-lines)) (avl-width (if prefix-left (- max-width prefix-left) max-width)) - (prefix-col (when prefix-left - (cons prefix-left - (append (list (concat prefix-w-face " ")) - (-repeat (- avl-lines 1) (s-repeat prefix-left " ")))))) (vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) - (result (which-key--partition-columns keys prefix-col avl-lines avl-width)) + (result (which-key--partition-columns keys avl-lines avl-width)) pages keys/page n-pages found prev-result) (cond ;; ((and (> n-rem-keys 0) use-status-key) ;; (setq status-key (propertize @@ -883,11 +873,8 @@ element in each list element of KEYS." (t (while (and (> avl-lines 1) (not found)) (setq avl-lines (- avl-lines 1) prev-result result - prefix-col (when prefix-left - (cons prefix-left - (-take avl-lines (cdr prefix-col)))) result (which-key--partition-columns - keys prefix-col avl-lines avl-width) + keys avl-lines avl-width) found (> (plist-get result :n-pages) 1))) (if (and (> avl-lines 1) found) prev-result result))))) @@ -904,17 +891,22 @@ PREFIX-KEYS holds the description of the prefix keys." (page (nth i (plist-get which-key--pages-plist :pages))) (height (plist-get which-key--pages-plist :page-height)) (width (nth i (plist-get which-key--pages-plist :page-widths))) - (prefix-w-face (which-key--propertize-key prefix-keys))) + (prefix-w-face (which-key--propertize-key prefix-keys)) + (prefix-width (string-width prefix-w-face)) + spaces) + (cond ((eq which-key-show-prefix 'left) + (setq spaces (s-repeat prefix-width " ") + page (concat + prefix-w-face " " + (s-replace "\n" (concat "\n " spaces) page)))) + ((eq which-key-show-prefix 'top) + (setq page (concat prefix-w-face "-\n" page)))) (if (eq which-key-popup-type 'minibuffer) - (if (eq which-key-show-prefix 'top) - (let (message-log-max) (message "%s" (concat prefix-w-face "-\n" page))) - (let (message-log-max) (message "%s" page))) + (let (message-log-max) (message "%s" page)) (with-current-buffer which-key--buffer (erase-buffer) - (if (eq which-key-show-prefix 'top) - (insert (concat prefix-w-face "-\n" page)) - (insert page)) - (goto-char (point-min)))) + (insert page) + (goto-char (point-max)))) (which-key--show-popup (cons height width)))))) ;; (setq map (make-sparse-keymap)) commit 45d6eb6f4f0c24082b8b9cbf4b54e606ebd2832e Author: Justin Burkett Date: Sun Jul 19 23:37:17 2015 -0400 Update README.org diff --git a/README.org b/README.org index 810deff70cb..fa85454185a 100644 --- a/README.org +++ b/README.org @@ -1,7 +1,16 @@ * which-key [[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]] ** Introduction -This is a rewrite of [[https://github.com/kai2nenobu/guide-key][guide-key-mode]] for emacs. The intention is to provide the +=which-key= is a minor mode for Emacs that displays the keybindings 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 keybindings 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. + +With respect to =guide-key=, the intention is to provide the following features: 1. A different polling mechanism to make it lighter on resources than guide-key 2. An improved display of keys with more keys being shown by default and a nicer commit 589baa51c594ab956ffd825390f765f2264ebd5a Author: Justin Burkett Date: Sun Jul 19 23:23:36 2015 -0400 Add a couple of docstrings diff --git a/which-key.el b/which-key.el index d1370268310..926b45668d9 100644 --- a/which-key.el +++ b/which-key.el @@ -252,7 +252,8 @@ to a non-nil value for the execution of a command. Like this 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--pages-plist nil) +(defvar which-key--pages-plist nil + "Internal: Holds page objects") ;;;###autoload (define-minor-mode which-key-mode @@ -891,6 +892,8 @@ element in each list element of KEYS." (if (and (> avl-lines 1) found) prev-result result))))) (defun which-key--show-page (n &optional prefix-keys) + "Show page N, starting from 0. +PREFIX-KEYS holds the description of the prefix keys." (let ((n-pages (plist-get which-key--pages-plist :n-pages))) (if (= 0 n-pages) (if prefix-keys commit 8bfe9cb732750293b8c01a383b320c783fb07d34 Merge: 1bac4b029c0 5ce4a5cb24f Author: Justin Burkett Date: Sun Jul 19 23:20:30 2015 -0400 Merge branch 'master' into develop Conflicts: README.org which-key.el commit 1bac4b029c07a5f0067a4768a8b4319cc99e9e74 Author: Justin Burkett Date: Sun Jul 19 23:02:26 2015 -0400 Fix prefix code Also delete old code diff --git a/which-key.el b/which-key.el index bab617ba2ac..941875f0fe4 100644 --- a/which-key.el +++ b/which-key.el @@ -766,151 +766,6 @@ element in each list element of KEYS." (cl-reduce (lambda (x y) (max x (string-width (nth index y)))) keys :initial-value 0)) -;; (defun which-key--create-page-vertical (keys max-lines max-width prefix-keys) -;; "Format KEYS into string representing a single page of text. -;; Creates columns (padded to be of uniform width) of length -;; MAX-LINES until keys run out or MAX-WIDTH is reached. A non-zero -;; PREFIX-WIDTH adds padding on the left side to allow for prefix -;; keys to be written into the upper left porition of the page." -;; (let* ((prefix-w-face (which-key--propertize-key prefix-keys)) -;; (prefix-width (if (eq which-key-show-prefix 'left) -;; (+ 2 (string-width prefix-w-face)) 0)) -;; (prefix-top (when (eq which-key-show-prefix 'top) -;; (concat prefix-w-face "-\n"))) -;; (avl-lines (if prefix-top (- max-lines 1) max-lines)) -;; (n-col-lines (min avl-lines (length keys))) -;; (prefix-col (when (eq which-key-show-prefix 'left) -;; (append (list (concat prefix-w-face " ")) -;; (-repeat (- n-col-lines 1) prefix-width)))) -;; (all-columns (if prefix-col (list prefix-col) '())) -;; ;; we get 1 back for not putting a space after the last column -;; (avl-width (max 0 (- (+ 1 max-width) -;; prefix-width -;; which-key-unicode-correction))) -;; (act-n-lines (- n-col-lines (if prefix-top 1 0))) -;; (act-width prefix-width) -;; (rem-keys keys) -;; (max-iter 100) (iter-n 0) -;; col-keys col-key-width col-desc-width col-width col-split done -;; new-column col-sep-width prev-rem-keys) -;; ;; (message "frame-width %s prefix-width %s avl-width %s max-width %s" -;; ;; (frame-text-cols) prefix-width avl-width max-width) -;; (while (and rem-keys (<= iter-n max-iter) (not done)) -;; (setq iter-n (1+ iter-n) -;; col-split (-split-at n-col-lines rem-keys) -;; col-keys (car col-split) -;; prev-rem-keys rem-keys -;; rem-keys (cadr col-split) -;; n-col-lines (min avl-lines (length rem-keys)) -;; col-key-width (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 (+ 3 col-key-width col-sep-width col-desc-width) -;; new-column -;; (mapcar (lambda (k) -;; (concat -;; (s-repeat (- col-key-width (string-width (nth 0 k))) " ") -;; (nth 0 k) " " (nth 1 k) " " (nth 2 k) -;; (s-repeat (- col-desc-width (string-width (nth 2 k))) " "))) -;; col-keys)) -;; (if (<= col-width avl-width) -;; (progn (push new-column all-columns) -;; (setq act-width (+ act-width col-width) -;; avl-width (- avl-width col-width))) -;; (setq done t rem-keys prev-rem-keys))) -;; (list :str (if prefix-top -;; (concat prefix-top (which-key--join-columns all-columns)) -;; (which-key--join-columns all-columns)) -;; :height act-n-lines :width act-width -;; :rem-keys rem-keys :n-rem-keys (length rem-keys) -;; :n-keys (- (length keys) (length rem-keys)) -;; :last-col-width col-width))) - -;; (defun which-key--create-page (keys max-lines max-width prefix-keys -;; &optional vertical use-status-key page-n) -;; "Create a page of KEYS with parameters MAX-LINES, MAX-WIDTH,PREFIX-WIDTH. -;; Use as many keys as possible. Use as few lines as possible unless -;; VERTICAL is non-nil. USE-STATUS-KEY inserts an informative -;; message in place of the last key on the page if non-nil. PAGE-N -;; allows for the informative message to reference the current page -;; number." -;; (let* ((n-keys (length keys)) -;; (first-try (which-key--create-page-vertical -;; keys max-lines max-width prefix-keys)) -;; (n-rem-keys (plist-get first-try :n-rem-keys)) -;; (status-key-i (- n-keys n-rem-keys 1)) -;; (next-try-lines max-lines) -;; (iter-n 0) -;; (max-iter (+ 1 max-lines)) -;; prev-try prev-n-rem-keys next-try found status-key first-try-str) -;; (cond ((and (> n-rem-keys 0) use-status-key) -;; (setq status-key (propertize -;; (format "%s keys not shown" (1+ n-rem-keys)) -;; 'face 'font-lock-comment-face) -;; first-try-str (plist-get first-try :str) -;; first-try-str (substring -;; first-try-str 0 -;; (- (length first-try-str) -;; (plist-get first-try :last-col-width)))) -;; (plist-put first-try :str (concat first-try-str status-key))) -;; ((or vertical (> n-rem-keys 0) (= 1 max-lines)) -;; first-try) -;; ;; do a simple search for the smallest number of lines -;; ;; TODO: Implement binary search -;; (t (while (and (<= iter-n max-iter) (not found)) -;; (setq iter-n (1+ iter-n) -;; prev-try next-try -;; next-try-lines (- next-try-lines 1) -;; next-try (which-key--create-page-vertical -;; keys next-try-lines max-width prefix-keys) -;; n-rem-keys (plist-get first-try :n-rem-keys) -;; found (or (= next-try-lines 0) (> n-rem-keys 0)))) -;; prev-try)))) - -;; (defun which-key--create-pages (prefix-keys formatted-keys sel-win-width) -;; "Insert FORMATTED-KEYS into which-key buffer. -;; PREFIX-KEYS may be inserted into the buffer depending on the -;; value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to -;; `which-key--popup-max-dimensions'." -;; (let* ((vertical (and (eq which-key-popup-type 'side-window) -;; (member which-key-side-window-location '(left right)))) -;; (max-dims (which-key--popup-max-dimensions sel-win-width)) -;; (max-lines (car max-dims)) -;; (avl-width (cdr max-dims)) -;; (rem-keys formatted-keys) -;; (max-pages (+ 1 (length formatted-keys))) -;; (page-n 0) -;; keys-per-page pages first-page first-page-str page-res no-room -;; max-pages-reached) -;; (while (and rem-keys (not max-pages-reached) (not no-room)) -;; (setq page-n (1+ page-n) -;; page-res (which-key--create-page -;; rem-keys max-lines avl-width prefix-keys -;; vertical which-key-show-remaining-keys page-n)) -;; (push page-res pages) -;; (push (if (plist-get page-res :n-keys) -;; (plist-get page-res :n-keys) 0) keys-per-page) -;; (setq rem-keys (plist-get page-res :rem-keys) -;; no-room (<= (car keys-per-page) 0) -;; max-pages-reached (>= page-n max-pages))) -;; ;; not doing anything with other pages for now -;; (setq keys-per-page (reverse keys-per-page) -;; pages (reverse pages)) - -;; first-page (car pages) -;; first-page-str (concat prefix-string (plist-get first-page :str))) -;; (cond ((<= (car keys-per-page) 0) ; check first page -;; (message "%s- which-key can't show keys: Settings and/or frame size\ -;; are too restrictive." prefix-keys) -;; (cons 0 0)) -;; (max-pages-reached -;; (error "Which-key reached the maximum number of pages") -;; (cons 0 0)) -;; ((<= (length formatted-keys) 0) -;; (message "%s- which-key: no keys to display" prefix-keys) -;; (cons 0 0)) -;; (t pages))) - (defun which-key--pad-column (col-keys) (let* ((col-key-width (which-key--max-len col-keys 0)) (col-sep-width (which-key--max-len col-keys 1)) @@ -924,11 +779,14 @@ element in each list element of KEYS." (s-repeat (- col-desc-width (string-width (nth 2 k))) " "))) col-keys)))) -(defun which-key--partition-columns (keys avl-lines avl-width) +(defun which-key--partition-columns (keys prefix-col avl-lines avl-width) (let ((cols-w-widths (mapcar #'which-key--pad-column (-partition-all avl-lines keys))) (page-width 0) (n-pages 0) page-cols pages keys/page page-widths) + (when (and prefix-col (<= (car prefix-col) avl-width)) + (push (cdr prefix-col) page-cols) + (setq page-width (car prefix-col))) (dolist (col cols-w-widths) (if (<= (+ (car col) page-width) avl-width) (progn (push (cdr col) page-cols) @@ -937,7 +795,10 @@ element in each list element of KEYS." (push (which-key--join-columns page-cols) pages) (push (* (length page-cols) avl-lines) keys/page) (push page-width page-widths) - (setq n-pages (1+ n-pages) page-cols '() page-width 0)))) + (setq n-pages (1+ n-pages) page-cols '() page-width 0) + (when (and prefix-col (<= (car prefix-col) avl-width)) + (push (cdr prefix-col) page-cols) + (setq page-width (car prefix-col)))))) (when (> (length page-cols) 0) (push (which-key--join-columns page-cols) pages) (push (* (length page-cols) avl-lines) keys/page) @@ -954,19 +815,17 @@ element in each list element of KEYS." (prefix-w-face (which-key--propertize-key prefix-keys)) (prefix-left (when (eq which-key-show-prefix 'left) (+ 2 (string-width prefix-w-face)))) - (prefix-top (when (eq which-key-show-prefix 'top) - (concat prefix-w-face "-\n"))) + (prefix-top (eq which-key-show-prefix 'top)) (avl-lines (if prefix-top (- max-lines 1) max-lines)) (avl-width (if prefix-left (- max-width prefix-left) max-width)) - ;; (prefix-col (when prefix-left - ;; (append (list (concat prefix-w-face " ")) - ;; (-repeat (- avl-lines 1) prefix-width)))) + (prefix-col (when prefix-left + (cons prefix-left + (append (list (concat prefix-w-face " ")) + (-repeat (- avl-lines 1) (s-repeat prefix-left " ")))))) (vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) - (result (which-key--partition-columns keys avl-lines avl-width)) + (result (which-key--partition-columns keys prefix-col avl-lines avl-width)) pages keys/page n-pages found prev-result) - ;; (message "FIRST RESULT\n%s" result) - ;; (message "%s %s %s" avl-lines avl-width (plist-get result :n-pages)) (cond ;; ((and (> n-rem-keys 0) use-status-key) ;; (setq status-key (propertize ;; (format "%s keys not shown" (1+ n-rem-keys)) @@ -983,8 +842,11 @@ element in each list element of KEYS." (t (while (and (> avl-lines 1) (not found)) (setq avl-lines (- avl-lines 1) prev-result result + prefix-col (when prefix-left + (cons prefix-left + (-take avl-lines (cdr prefix-col)))) result (which-key--partition-columns - keys avl-lines avl-width) + keys prefix-col avl-lines avl-width) found (> (plist-get result :n-pages) 1))) (if (and (> avl-lines 1) found) prev-result result))))) @@ -998,17 +860,23 @@ element in each list element of KEYS." (let* ((i (mod n n-pages)) (page (nth i (plist-get which-key--pages-plist :pages))) (height (plist-get which-key--pages-plist :page-height)) - (width (nth i (plist-get which-key--pages-plist :page-widths)))) + (width (nth i (plist-get which-key--pages-plist :page-widths))) + (prefix-w-face (which-key--propertize-key prefix-keys))) (if (eq which-key-popup-type 'minibuffer) - (let (message-log-max) (message "%s" page)) + (if (eq which-key-show-prefix 'top) + (let (message-log-max) (message "%s" (concat prefix-w-face "-\n" page))) + (let (message-log-max) (message "%s" page))) (with-current-buffer which-key--buffer (erase-buffer) - (insert page) + (if (eq which-key-show-prefix 'top) + (insert (concat prefix-w-face "-\n" page)) + (insert page)) (goto-char (point-min)))) (which-key--show-popup (cons height width)))))) -(evil-leader/set-key "C-M-2" (lambda () (interactive) (which-key--show-page 1))) -(evil-leader/set-key "C-M-2" (lambda () (interactive) (which-key--show-page 1))) +;; (setq map (make-sparse-keymap)) +;; (define-key map (kbd "C-M-1") (lambda () (interactive) (which-key--show-page 0))) +;; (define-key map (kbd "C-M-2") (lambda () (interactive) (which-key--show-page 1))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update @@ -1050,5 +918,8 @@ Finally, show the buffer." (when which-key--open-timer (cancel-timer which-key--open-timer))) +;; TODO +;; fix status key + (provide 'which-key) ;;; which-key.el ends here commit e2013569302ea2287ec5238d9e89925f9a71ea44 Author: Justin Burkett Date: Sun Jul 19 22:18:47 2015 -0400 Paging works barely diff --git a/which-key.el b/which-key.el index 089003a9c64..bab617ba2ac 100644 --- a/which-key.el +++ b/which-key.el @@ -933,10 +933,11 @@ element in each list element of KEYS." (if (<= (+ (car col) page-width) avl-width) (progn (push (cdr col) page-cols) (setq page-width (+ page-width (car col)))) - (push (which-key--join-columns page-cols) pages) - (push (* (length page-cols) avl-lines) keys/page) - (push page-width page-widths) - (setq n-pages (1+ n-pages) page-cols '() page-width 0))) + (when (> (length page-cols) 0) + (push (which-key--join-columns page-cols) pages) + (push (* (length page-cols) avl-lines) keys/page) + (push page-width page-widths) + (setq n-pages (1+ n-pages) page-cols '() page-width 0)))) (when (> (length page-cols) 0) (push (which-key--join-columns page-cols) pages) (push (* (length page-cols) avl-lines) keys/page) @@ -987,18 +988,27 @@ element in each list element of KEYS." found (> (plist-get result :n-pages) 1))) (if (and (> avl-lines 1) found) prev-result result))))) -(defun which-key--show-page (n) - (let* ((i (mod n (length which-key--pages-plist))) - (page (nth i (plist-get which-key--pages-plist :pages))) - (height (plist-get which-key--pages-plist :page-height)) - (width (nth i (plist-get which-key--pages-plist :page-widths)))) - (if (eq which-key-popup-type 'minibuffer) - (let (message-log-max) (message "%s" page)) - (with-current-buffer which-key--buffer - (erase-buffer) - (insert page) - (goto-char (point-min)))) - (which-key--show-popup (cons height width)))) +(defun which-key--show-page (n &optional prefix-keys) + (let ((n-pages (plist-get which-key--pages-plist :n-pages))) + (if (= 0 n-pages) + (if prefix-keys + (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." + prefix-keys) + (message "which-key can't show keys: Settings and/or frame size are too restrictive.")) + (let* ((i (mod n n-pages)) + (page (nth i (plist-get which-key--pages-plist :pages))) + (height (plist-get which-key--pages-plist :page-height)) + (width (nth i (plist-get which-key--pages-plist :page-widths)))) + (if (eq which-key-popup-type 'minibuffer) + (let (message-log-max) (message "%s" page)) + (with-current-buffer which-key--buffer + (erase-buffer) + (insert page) + (goto-char (point-min)))) + (which-key--show-popup (cons height width)))))) + +(evil-leader/set-key "C-M-2" (lambda () (interactive) (which-key--show-page 1))) +(evil-leader/set-key "C-M-2" (lambda () (interactive) (which-key--show-page 1))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update @@ -1020,11 +1030,12 @@ Finally, show the buffer." (keymapp (lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) (let ((formatted-keys (which-key--get-formatted-key-bindings - (current-buffer) prefix-keys))) + (current-buffer) prefix-keys)) + (prefix-keys-desc (key-description prefix-keys))) (setq which-key--pages-plist (which-key--create-pages - (key-description prefix-keys) - formatted-keys (window-width))) - (which-key--show-page 0))))) + prefix-keys-desc formatted-keys + (window-width))) + (which-key--show-page 0 prefix-keys-desc))))) ;; Timers commit 0e6076b44187ea2815c04cc0a44055091fa8d2cc Author: Justin Burkett Date: Sun Jul 19 21:59:02 2015 -0400 Rewrite of page creation alg diff --git a/which-key.el b/which-key.el index dea9d6317b2..089003a9c64 100644 --- a/which-key.el +++ b/which-key.el @@ -247,6 +247,7 @@ to a non-nil value for the execution of a command. Like this 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--pages-plist nil) ;;;###autoload (define-minor-mode which-key-mode @@ -755,11 +756,8 @@ BUFFER that follow the key sequence KEY-SEQ." (defsubst which-key--join-columns (columns) "Transpose columns into rows, concat rows into lines and rows into page." - (let* (;; pad reversed columns to same length - (padded (apply (apply-partially #'-pad "") (reverse columns))) - ;; transpose columns to rows + (let* ((padded (apply (apply-partially #'-pad "") (reverse columns))) (rows (apply #'cl-mapcar #'list padded))) - ;; join lines by space and rows by newline (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n"))) (defsubst which-key--max-len (keys index) @@ -768,161 +766,239 @@ element in each list element of KEYS." (cl-reduce (lambda (x y) (max x (string-width (nth index y)))) keys :initial-value 0)) -(defun which-key--create-page-vertical (keys max-lines max-width prefix-width) - "Format KEYS into string representing a single page of text. -Creates columns (padded to be of uniform width) of length -MAX-LINES until keys run out or MAX-WIDTH is reached. A non-zero -PREFIX-WIDTH adds padding on the left side to allow for prefix -keys to be written into the upper left porition of the page." - (let* ((n-keys (length keys)) - (avl-lines max-lines) - ;; we get 1 back for not putting a space after the last column - (avl-width (max 0 (- (+ 1 max-width) - prefix-width - which-key-unicode-correction))) - (rem-keys keys) - (n-col-lines (min avl-lines n-keys)) - (act-n-lines n-col-lines) ; n-col-lines in first column - ;; Initial column for prefix (if used) - (all-columns (list - (mapcar (lambda (i) - (if (> i 1) (s-repeat prefix-width " ") "")) - (number-sequence 1 n-col-lines)))) - (act-width prefix-width) - (max-iter 100) (iter-n 0) - col-keys col-key-width col-desc-width col-width col-split done - new-column col-sep-width prev-rem-keys) - ;; (message "frame-width %s prefix-width %s avl-width %s max-width %s" - ;; (frame-text-cols) prefix-width avl-width max-width) - (while (and rem-keys (<= iter-n max-iter) (not done)) - (setq iter-n (1+ iter-n) - col-split (-split-at n-col-lines rem-keys) - col-keys (car col-split) - prev-rem-keys rem-keys - rem-keys (cadr col-split) - n-col-lines (min avl-lines (length rem-keys)) - col-key-width (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 (+ 3 col-key-width col-sep-width col-desc-width) - new-column (mapcar - (lambda (k) - (concat (s-repeat (- col-key-width - (string-width (nth 0 k))) - " ") - (nth 0 k) " " (nth 1 k) " " (nth 2 k) - (s-repeat (- col-desc-width - (string-width (nth 2 k))) - " "))) col-keys)) - (if (<= col-width avl-width) - (progn (push new-column all-columns) - (setq act-width (+ act-width col-width) - avl-width (- avl-width col-width))) - (setq done t - rem-keys prev-rem-keys))) - (list :str (which-key--join-columns all-columns) - :height act-n-lines :width act-width - :rem-keys rem-keys :n-rem-keys (length rem-keys) - :n-keys (- n-keys (length rem-keys)) - :last-col-width col-width))) - -(defun which-key--create-page (keys max-lines max-width prefix-width - &optional vertical use-status-key page-n) - "Create a page of KEYS with parameters MAX-LINES, MAX-WIDTH,PREFIX-WIDTH. -Use as many keys as possible. Use as few lines as possible unless -VERTICAL is non-nil. USE-STATUS-KEY inserts an informative -message in place of the last key on the page if non-nil. PAGE-N -allows for the informative message to reference the current page -number." - (let* ((n-keys (length keys)) - (first-try (which-key--create-page-vertical - keys max-lines max-width prefix-width)) - (n-rem-keys (plist-get first-try :n-rem-keys)) - (status-key-i (- n-keys n-rem-keys 1)) - (next-try-lines max-lines) - (iter-n 0) - (max-iter (+ 1 max-lines)) - prev-try prev-n-rem-keys next-try found status-key first-try-str) - (cond ((and (> n-rem-keys 0) use-status-key) - (setq status-key (propertize - (format "%s keys not shown" (1+ n-rem-keys)) - 'face 'font-lock-comment-face) - first-try-str (plist-get first-try :str) - first-try-str (substring - first-try-str 0 - (- (length first-try-str) - (plist-get first-try :last-col-width)))) - (plist-put first-try :str (concat first-try-str status-key))) - ((or vertical (> n-rem-keys 0) (= 1 max-lines)) - first-try) - ;; do a simple search for the smallest number of lines - ;; TODO: Implement binary search - (t (while (and (<= iter-n max-iter) (not found)) - (setq iter-n (1+ iter-n) - prev-try next-try - next-try-lines (- next-try-lines 1) - next-try (which-key--create-page-vertical - keys next-try-lines max-width prefix-width) - n-rem-keys (plist-get first-try :n-rem-keys) - found (or (= next-try-lines 0) (> n-rem-keys 0)))) - prev-try)))) - -(defun which-key--populate-buffer (prefix-keys formatted-keys sel-win-width) - "Insert FORMATTED-KEYS into which-key buffer. -PREFIX-KEYS may be inserted into the buffer depending on the -value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to -`which-key--popup-max-dimensions'." - (let* ((vertical (and (eq which-key-popup-type 'side-window) - (member which-key-side-window-location '(left right)))) - (prefix-w-face (which-key--propertize-key prefix-keys)) - (prefix-len (+ 2 (string-width prefix-w-face))) - (prefix-string (when which-key-show-prefix - (if (eq which-key-show-prefix 'left) - (concat prefix-w-face " ") - (concat prefix-w-face "-\n")))) - (max-dims (which-key--popup-max-dimensions sel-win-width)) +;; (defun which-key--create-page-vertical (keys max-lines max-width prefix-keys) +;; "Format KEYS into string representing a single page of text. +;; Creates columns (padded to be of uniform width) of length +;; MAX-LINES until keys run out or MAX-WIDTH is reached. A non-zero +;; PREFIX-WIDTH adds padding on the left side to allow for prefix +;; keys to be written into the upper left porition of the page." +;; (let* ((prefix-w-face (which-key--propertize-key prefix-keys)) +;; (prefix-width (if (eq which-key-show-prefix 'left) +;; (+ 2 (string-width prefix-w-face)) 0)) +;; (prefix-top (when (eq which-key-show-prefix 'top) +;; (concat prefix-w-face "-\n"))) +;; (avl-lines (if prefix-top (- max-lines 1) max-lines)) +;; (n-col-lines (min avl-lines (length keys))) +;; (prefix-col (when (eq which-key-show-prefix 'left) +;; (append (list (concat prefix-w-face " ")) +;; (-repeat (- n-col-lines 1) prefix-width)))) +;; (all-columns (if prefix-col (list prefix-col) '())) +;; ;; we get 1 back for not putting a space after the last column +;; (avl-width (max 0 (- (+ 1 max-width) +;; prefix-width +;; which-key-unicode-correction))) +;; (act-n-lines (- n-col-lines (if prefix-top 1 0))) +;; (act-width prefix-width) +;; (rem-keys keys) +;; (max-iter 100) (iter-n 0) +;; col-keys col-key-width col-desc-width col-width col-split done +;; new-column col-sep-width prev-rem-keys) +;; ;; (message "frame-width %s prefix-width %s avl-width %s max-width %s" +;; ;; (frame-text-cols) prefix-width avl-width max-width) +;; (while (and rem-keys (<= iter-n max-iter) (not done)) +;; (setq iter-n (1+ iter-n) +;; col-split (-split-at n-col-lines rem-keys) +;; col-keys (car col-split) +;; prev-rem-keys rem-keys +;; rem-keys (cadr col-split) +;; n-col-lines (min avl-lines (length rem-keys)) +;; col-key-width (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 (+ 3 col-key-width col-sep-width col-desc-width) +;; new-column +;; (mapcar (lambda (k) +;; (concat +;; (s-repeat (- col-key-width (string-width (nth 0 k))) " ") +;; (nth 0 k) " " (nth 1 k) " " (nth 2 k) +;; (s-repeat (- col-desc-width (string-width (nth 2 k))) " "))) +;; col-keys)) +;; (if (<= col-width avl-width) +;; (progn (push new-column all-columns) +;; (setq act-width (+ act-width col-width) +;; avl-width (- avl-width col-width))) +;; (setq done t rem-keys prev-rem-keys))) +;; (list :str (if prefix-top +;; (concat prefix-top (which-key--join-columns all-columns)) +;; (which-key--join-columns all-columns)) +;; :height act-n-lines :width act-width +;; :rem-keys rem-keys :n-rem-keys (length rem-keys) +;; :n-keys (- (length keys) (length rem-keys)) +;; :last-col-width col-width))) + +;; (defun which-key--create-page (keys max-lines max-width prefix-keys +;; &optional vertical use-status-key page-n) +;; "Create a page of KEYS with parameters MAX-LINES, MAX-WIDTH,PREFIX-WIDTH. +;; Use as many keys as possible. Use as few lines as possible unless +;; VERTICAL is non-nil. USE-STATUS-KEY inserts an informative +;; message in place of the last key on the page if non-nil. PAGE-N +;; allows for the informative message to reference the current page +;; number." +;; (let* ((n-keys (length keys)) +;; (first-try (which-key--create-page-vertical +;; keys max-lines max-width prefix-keys)) +;; (n-rem-keys (plist-get first-try :n-rem-keys)) +;; (status-key-i (- n-keys n-rem-keys 1)) +;; (next-try-lines max-lines) +;; (iter-n 0) +;; (max-iter (+ 1 max-lines)) +;; prev-try prev-n-rem-keys next-try found status-key first-try-str) +;; (cond ((and (> n-rem-keys 0) use-status-key) +;; (setq status-key (propertize +;; (format "%s keys not shown" (1+ n-rem-keys)) +;; 'face 'font-lock-comment-face) +;; first-try-str (plist-get first-try :str) +;; first-try-str (substring +;; first-try-str 0 +;; (- (length first-try-str) +;; (plist-get first-try :last-col-width)))) +;; (plist-put first-try :str (concat first-try-str status-key))) +;; ((or vertical (> n-rem-keys 0) (= 1 max-lines)) +;; first-try) +;; ;; do a simple search for the smallest number of lines +;; ;; TODO: Implement binary search +;; (t (while (and (<= iter-n max-iter) (not found)) +;; (setq iter-n (1+ iter-n) +;; prev-try next-try +;; next-try-lines (- next-try-lines 1) +;; next-try (which-key--create-page-vertical +;; keys next-try-lines max-width prefix-keys) +;; n-rem-keys (plist-get first-try :n-rem-keys) +;; found (or (= next-try-lines 0) (> n-rem-keys 0)))) +;; prev-try)))) + +;; (defun which-key--create-pages (prefix-keys formatted-keys sel-win-width) +;; "Insert FORMATTED-KEYS into which-key buffer. +;; PREFIX-KEYS may be inserted into the buffer depending on the +;; value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to +;; `which-key--popup-max-dimensions'." +;; (let* ((vertical (and (eq which-key-popup-type 'side-window) +;; (member which-key-side-window-location '(left right)))) +;; (max-dims (which-key--popup-max-dimensions sel-win-width)) +;; (max-lines (car max-dims)) +;; (avl-width (cdr max-dims)) +;; (rem-keys formatted-keys) +;; (max-pages (+ 1 (length formatted-keys))) +;; (page-n 0) +;; keys-per-page pages first-page first-page-str page-res no-room +;; max-pages-reached) +;; (while (and rem-keys (not max-pages-reached) (not no-room)) +;; (setq page-n (1+ page-n) +;; page-res (which-key--create-page +;; rem-keys max-lines avl-width prefix-keys +;; vertical which-key-show-remaining-keys page-n)) +;; (push page-res pages) +;; (push (if (plist-get page-res :n-keys) +;; (plist-get page-res :n-keys) 0) keys-per-page) +;; (setq rem-keys (plist-get page-res :rem-keys) +;; no-room (<= (car keys-per-page) 0) +;; max-pages-reached (>= page-n max-pages))) +;; ;; not doing anything with other pages for now +;; (setq keys-per-page (reverse keys-per-page) +;; pages (reverse pages)) + +;; first-page (car pages) +;; first-page-str (concat prefix-string (plist-get first-page :str))) +;; (cond ((<= (car keys-per-page) 0) ; check first page +;; (message "%s- which-key can't show keys: Settings and/or frame size\ +;; are too restrictive." prefix-keys) +;; (cons 0 0)) +;; (max-pages-reached +;; (error "Which-key reached the maximum number of pages") +;; (cons 0 0)) +;; ((<= (length formatted-keys) 0) +;; (message "%s- which-key: no keys to display" prefix-keys) +;; (cons 0 0)) +;; (t pages))) + +(defun which-key--pad-column (col-keys) + (let* ((col-key-width (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 (+ 3 col-key-width col-sep-width col-desc-width))) + (cons col-width + (mapcar (lambda (k) + (concat + (s-repeat (- col-key-width (string-width (nth 0 k))) " ") + (nth 0 k) " " (nth 1 k) " " (nth 2 k) + (s-repeat (- col-desc-width (string-width (nth 2 k))) " "))) + col-keys)))) + +(defun which-key--partition-columns (keys avl-lines avl-width) + (let ((cols-w-widths (mapcar #'which-key--pad-column + (-partition-all avl-lines keys))) + (page-width 0) (n-pages 0) + page-cols pages keys/page page-widths) + (dolist (col cols-w-widths) + (if (<= (+ (car col) page-width) avl-width) + (progn (push (cdr col) page-cols) + (setq page-width (+ page-width (car col)))) + (push (which-key--join-columns page-cols) pages) + (push (* (length page-cols) avl-lines) keys/page) + (push page-width page-widths) + (setq n-pages (1+ n-pages) page-cols '() page-width 0))) + (when (> (length page-cols) 0) + (push (which-key--join-columns page-cols) pages) + (push (* (length page-cols) avl-lines) keys/page) + (push page-width page-widths) + (setq n-pages (1+ n-pages))) + (list :pages (reverse pages) :page-height avl-lines + :page-widths (reverse page-widths) + :keys/page (reverse keys/page) :n-pages n-pages))) + +(defun which-key--create-pages (prefix-keys keys sel-win-width) + (let* ((max-dims (which-key--popup-max-dimensions sel-win-width)) (max-lines (car max-dims)) - (avl-width (cdr max-dims)) - (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) - (rem-keys formatted-keys) - (max-pages (+ 1 (length formatted-keys))) - (page-n 0) - keys-per-page pages first-page first-page-str page-res no-room - max-pages-reached) - (while (and rem-keys (not max-pages-reached) (not no-room)) - (setq page-n (1+ page-n) - page-res (which-key--create-page - rem-keys max-lines avl-width prefix-width - vertical which-key-show-remaining-keys page-n)) - (push page-res pages) - (push (if (plist-get page-res :n-keys) - (plist-get page-res :n-keys) 0) keys-per-page) - (setq rem-keys (plist-get page-res :rem-keys) - no-room (<= (car keys-per-page) 0) - max-pages-reached (>= page-n max-pages))) - ;; not doing anything with other pages for now - (setq keys-per-page (reverse keys-per-page) - pages (reverse pages) - first-page (car pages) - first-page-str (concat prefix-string (plist-get first-page :str))) - (cond ((<= (car keys-per-page) 0) ; check first page - (message "%s- which-key can't show keys: Settings and/or frame size\ - are too restrictive." prefix-keys) - (cons 0 0)) - (max-pages-reached - (error "Which-key reached the maximum number of pages") - (cons 0 0)) - ((<= (length formatted-keys) 0) - (message "%s- which-key: no keys to display" prefix-keys) - (cons 0 0)) - (t - (if (eq which-key-popup-type 'minibuffer) - (let (message-log-max) (message "%s" first-page-str)) - (with-current-buffer which-key--buffer - (erase-buffer) - (insert first-page-str) - (goto-char (point-min)))) - (cons (plist-get first-page :height) (plist-get first-page :width)))))) + (max-width (cdr max-dims)) + (prefix-w-face (which-key--propertize-key prefix-keys)) + (prefix-left (when (eq which-key-show-prefix 'left) + (+ 2 (string-width prefix-w-face)))) + (prefix-top (when (eq which-key-show-prefix 'top) + (concat prefix-w-face "-\n"))) + (avl-lines (if prefix-top (- max-lines 1) max-lines)) + (avl-width (if prefix-left (- max-width prefix-left) max-width)) + ;; (prefix-col (when prefix-left + ;; (append (list (concat prefix-w-face " ")) + ;; (-repeat (- avl-lines 1) prefix-width)))) + (vertical (and (eq which-key-popup-type 'side-window) + (member which-key-side-window-location '(left right)))) + (result (which-key--partition-columns keys avl-lines avl-width)) + pages keys/page n-pages found prev-result) + ;; (message "FIRST RESULT\n%s" result) + ;; (message "%s %s %s" avl-lines avl-width (plist-get result :n-pages)) + (cond ;; ((and (> n-rem-keys 0) use-status-key) + ;; (setq status-key (propertize + ;; (format "%s keys not shown" (1+ n-rem-keys)) + ;; 'face 'font-lock-comment-face) + ;; first-try-str (plist-get first-try :str) + ;; first-try-str (substring + ;; first-try-str 0 + ;; (- (length first-try-str) + ;; (plist-get first-try :last-col-width)))) + ;; (plist-put first-try :str (concat first-try-str status-key))) + ((or vertical (> (plist-get result :n-pages) 1) (= 1 avl-lines)) + result) + ;; do a simple search for the smallest number of lines + (t (while (and (> avl-lines 1) (not found)) + (setq avl-lines (- avl-lines 1) + prev-result result + result (which-key--partition-columns + keys avl-lines avl-width) + found (> (plist-get result :n-pages) 1))) + (if (and (> avl-lines 1) found) prev-result result))))) + +(defun which-key--show-page (n) + (let* ((i (mod n (length which-key--pages-plist))) + (page (nth i (plist-get which-key--pages-plist :pages))) + (height (plist-get which-key--pages-plist :page-height)) + (width (nth i (plist-get which-key--pages-plist :page-widths)))) + (if (eq which-key-popup-type 'minibuffer) + (let (message-log-max) (message "%s" page)) + (with-current-buffer which-key--buffer + (erase-buffer) + (insert page) + (goto-char (point-min)))) + (which-key--show-popup (cons height width)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update @@ -943,13 +1019,12 @@ Finally, show the buffer." ;; just in case someone uses one of these (keymapp (lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) - (let* ((buf (current-buffer)) - (formatted-keys (which-key--get-formatted-key-bindings - buf prefix-keys)) - (popup-act-dim (which-key--populate-buffer - (key-description prefix-keys) - formatted-keys (window-width)))) - (which-key--show-popup popup-act-dim))))) + (let ((formatted-keys (which-key--get-formatted-key-bindings + (current-buffer) prefix-keys))) + (setq which-key--pages-plist (which-key--create-pages + (key-description prefix-keys) + formatted-keys (window-width))) + (which-key--show-page 0))))) ;; Timers commit 5ce4a5cb24f4a83e2259751f6ffebbdf44acc14d Author: Justin Burkett Date: Fri Jul 17 13:41:34 2015 -0400 Typo in docstring diff --git a/which-key.el b/which-key.el index 173b4718220..21980d3a5f9 100644 --- a/which-key.el +++ b/which-key.el @@ -733,8 +733,8 @@ alists. Returns a list (key separator description)." (defun which-key--key-description< (a b) "Order key descriptions A and B. -Order is lexicographic within a \"class\". Where the classes and -the ordering of classes is listed below. +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." (let* ((aem? (string-equal a "")) commit 9d3ffef3f15e96ddd0efdca1144ee0b56b92b885 Author: Justin Burkett Date: Fri Jul 17 13:03:00 2015 -0400 Add special key handling to key sort order diff --git a/which-key.el b/which-key.el index 4cc1272aba7..173b4718220 100644 --- a/which-key.el +++ b/which-key.el @@ -732,13 +732,34 @@ alists. Returns a list (key separator description)." unformatted))) (defun which-key--key-description< (a b) - "Order key descriptions A and B." - (let ((la (string-width a)) - (lb (string-width b))) - (cond ((and (= la 1) (= lb 1)) (string-lessp a b)) - ((or (= la 1) (= lb 1)) (= la 1)) - ((string-equal (substring a 0 2) (substring b 0 2)) - (which-key--key-description< (substring a 2) (substring b 2))) + "Order key descriptions A and B. +Order is lexicographic within a \"class\". Where the classes and +the ordering of classes is listed below. + +special (SPC,TAB,...) < single char < mod (C-,M-,...) < other." + (let* ((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))) + (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)) + (string-lessp a b))) + ((or asp? bsp?) asp?) + ((and a1? b1?) (string-lessp a b)) + ((or a1? b1?) a1?) + ((and apr? bpr?) + (if (string-equal (substring a 0 2) (substring b 0 2)) + (which-key--key-description< (substring a 2) (substring b 2)) + (string-lessp a b))) + ((or apr? bpr?) apr?) (t (string-lessp a b))))) (defun which-key--get-formatted-key-bindings (buffer key-seq) commit 2c6ab4da10070dc6ab304798fbd4d6b24262c42d Author: Justin Burkett Date: Fri Jul 17 10:49:11 2015 -0400 Add option to sort output by key (off by default) diff --git a/which-key.el b/which-key.el index b54aedb883f..4cc1272aba7 100644 --- a/which-key.el +++ b/which-key.el @@ -177,6 +177,11 @@ a percentage out of the frame's height." :type '(radio (const :tag "Yes" t) (const :tag "No" nil))) +(defcustom which-key-sort nil + "Sort output by `key-description' if non-nil." + :group 'which-key + :type 'boolean) + ;; Faces (defface which-key-key-face '((t . (:inherit font-lock-constant-face))) @@ -726,6 +731,16 @@ alists. Returns a list (key separator description)." (list key-w-face sep-w-face desc-w-face))) unformatted))) +(defun which-key--key-description< (a b) + "Order key descriptions A and B." + (let ((la (string-width a)) + (lb (string-width b))) + (cond ((and (= la 1) (= lb 1)) (string-lessp a b)) + ((or (= la 1) (= lb 1)) (= la 1)) + ((string-equal (substring a 0 2) (substring b 0 2)) + (which-key--key-description< (substring a 2) (substring b 2))) + (t (string-lessp a b))))) + (defun which-key--get-formatted-key-bindings (buffer key-seq) "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." @@ -743,6 +758,10 @@ BUFFER that follow the key sequence KEY-SEQ." desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted :test (lambda (x y) (string-equal (car x) (car y)))))) + (when which-key-sort + (setq unformatted + (sort unformatted + (lambda (a b) (which-key--key-description< (car a) (car b)))))) (which-key--format-and-replace unformatted (key-description key-seq)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; commit 23600ce6e1eecafa5be91820b40ce148a08e557e Author: Justin Burkett Date: Fri Jul 17 10:59:13 2015 -0400 Fix potential bug when no keys exist Need to check for no keys before checking the number of keys on the first page in case the latter is nil diff --git a/which-key.el b/which-key.el index ac57514d491..b54aedb883f 100644 --- a/which-key.el +++ b/which-key.el @@ -894,15 +894,15 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to pages (reverse pages) first-page (car pages) first-page-str (concat prefix-string (car first-page))) - (cond ((<= (car keys-per-page) 0) ; check first page - (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." prefix-keys) - (cons 0 0)) - (max-pages-reached + (cond (max-pages-reached (error "Which-key reached the maximum number of pages") (cons 0 0)) ((<= (length formatted-keys) 0) (message "%s- which-key: no keys to display" prefix-keys) (cons 0 0)) + ((<= (car keys-per-page) 0) ; check first page + (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." prefix-keys) + (cons 0 0)) (t (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" first-page-str)) commit 891fc5f636928926e8d0db2e56bd45603461b8c8 Author: Justin Burkett Date: Fri Jul 17 09:22:18 2015 -0400 Start on new status key impl diff --git a/which-key.el b/which-key.el index a5b1020915a..dea9d6317b2 100644 --- a/which-key.el +++ b/which-key.el @@ -766,9 +766,7 @@ BUFFER that follow the key sequence KEY-SEQ." "Internal function for finding the max length of the INDEX element in each list element of KEYS." (cl-reduce - (lambda (x y) (max x (if (eq (car y) 'status) - 0 (string-width (nth index y))))) - keys :initial-value 0)) + (lambda (x y) (max x (string-width (nth index y)))) keys :initial-value 0)) (defun which-key--create-page-vertical (keys max-lines max-width prefix-width) "Format KEYS into string representing a single page of text. @@ -791,13 +789,12 @@ keys to be written into the upper left porition of the page." (if (> i 1) (s-repeat prefix-width " ") "")) (number-sequence 1 n-col-lines)))) (act-width prefix-width) - (max-iter 100) - (iter-n 0) + (max-iter 100) (iter-n 0) col-keys col-key-width col-desc-width col-width col-split done - new-column page col-sep-width prev-rem-keys) + new-column col-sep-width prev-rem-keys) ;; (message "frame-width %s prefix-width %s avl-width %s max-width %s" ;; (frame-text-cols) prefix-width avl-width max-width) - (while (and (<= iter-n max-iter) (not done)) + (while (and rem-keys (<= iter-n max-iter) (not done)) (setq iter-n (1+ iter-n) col-split (-split-at n-col-lines rem-keys) col-keys (car col-split) @@ -810,23 +807,24 @@ keys to be written into the upper left porition of the page." col-width (+ 3 col-key-width col-sep-width col-desc-width) new-column (mapcar (lambda (k) - (if (eq (car k) 'status) - (concat (s-repeat (+ col-key-width col-sep-width) " ") " " (cdr k)) - (concat (s-repeat (- col-key-width - (string-width (nth 0 k))) " ") - (nth 0 k) " " (nth 1 k) " " (nth 2 k) - (s-repeat (- col-desc-width - (string-width (nth 2 k))) " ")))) - col-keys)) + (concat (s-repeat (- col-key-width + (string-width (nth 0 k))) + " ") + (nth 0 k) " " (nth 1 k) " " (nth 2 k) + (s-repeat (- col-desc-width + (string-width (nth 2 k))) + " "))) col-keys)) (if (<= col-width avl-width) (progn (push new-column all-columns) - (setq act-width (+ act-width col-width) - avl-width (- avl-width col-width))) + (setq act-width (+ act-width col-width) + avl-width (- avl-width col-width))) (setq done t - rem-keys prev-rem-keys)) - (when (<= (length rem-keys) 0) (setq done t))) - (setq page (which-key--join-columns all-columns)) - (list page act-n-lines act-width rem-keys (- n-keys (length rem-keys))))) + rem-keys prev-rem-keys))) + (list :str (which-key--join-columns all-columns) + :height act-n-lines :width act-width + :rem-keys rem-keys :n-rem-keys (length rem-keys) + :n-keys (- n-keys (length rem-keys)) + :last-col-width col-width))) (defun which-key--create-page (keys max-lines max-width prefix-width &optional vertical use-status-key page-n) @@ -839,19 +837,22 @@ number." (let* ((n-keys (length keys)) (first-try (which-key--create-page-vertical keys max-lines max-width prefix-width)) - (n-rem-keys (length (nth 3 first-try))) + (n-rem-keys (plist-get first-try :n-rem-keys)) (status-key-i (- n-keys n-rem-keys 1)) (next-try-lines max-lines) (iter-n 0) (max-iter (+ 1 max-lines)) - prev-try prev-n-rem-keys next-try found status-key) + prev-try prev-n-rem-keys next-try found status-key first-try-str) (cond ((and (> n-rem-keys 0) use-status-key) - (setq status-key - (cons 'status (propertize - (format "%s keys not shown" (1+ n-rem-keys)) - 'face 'font-lock-comment-face))) - (which-key--create-page-vertical (-insert-at status-key-i status-key keys) - max-lines max-width prefix-width)) + (setq status-key (propertize + (format "%s keys not shown" (1+ n-rem-keys)) + 'face 'font-lock-comment-face) + first-try-str (plist-get first-try :str) + first-try-str (substring + first-try-str 0 + (- (length first-try-str) + (plist-get first-try :last-col-width)))) + (plist-put first-try :str (concat first-try-str status-key))) ((or vertical (> n-rem-keys 0) (= 1 max-lines)) first-try) ;; do a simple search for the smallest number of lines @@ -862,7 +863,7 @@ number." next-try-lines (- next-try-lines 1) next-try (which-key--create-page-vertical keys next-try-lines max-width prefix-width) - n-rem-keys (length (nth 3 next-try)) + n-rem-keys (plist-get first-try :n-rem-keys) found (or (= next-try-lines 0) (> n-rem-keys 0)))) prev-try)))) @@ -883,26 +884,27 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to (max-lines (car max-dims)) (avl-width (cdr max-dims)) (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) - (keys-rem formatted-keys) + (rem-keys formatted-keys) (max-pages (+ 1 (length formatted-keys))) (page-n 0) keys-per-page pages first-page first-page-str page-res no-room max-pages-reached) - (while (and keys-rem (not max-pages-reached) (not no-room)) + (while (and rem-keys (not max-pages-reached) (not no-room)) (setq page-n (1+ page-n) page-res (which-key--create-page - keys-rem max-lines avl-width prefix-width + rem-keys max-lines avl-width prefix-width vertical which-key-show-remaining-keys page-n)) (push page-res pages) - (push (if (nth 4 page-res) (nth 4 page-res) 0) keys-per-page) - (setq keys-rem (nth 3 page-res) + (push (if (plist-get page-res :n-keys) + (plist-get page-res :n-keys) 0) keys-per-page) + (setq rem-keys (plist-get page-res :rem-keys) no-room (<= (car keys-per-page) 0) max-pages-reached (>= page-n max-pages))) ;; not doing anything with other pages for now (setq keys-per-page (reverse keys-per-page) pages (reverse pages) first-page (car pages) - first-page-str (concat prefix-string (car first-page))) + first-page-str (concat prefix-string (plist-get first-page :str))) (cond ((<= (car keys-per-page) 0) ; check first page (message "%s- which-key can't show keys: Settings and/or frame size\ are too restrictive." prefix-keys) @@ -920,7 +922,7 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to (erase-buffer) (insert first-page-str) (goto-char (point-min)))) - (cons (nth 1 first-page) (nth 2 first-page)))))) + (cons (plist-get first-page :height) (plist-get first-page :width)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update commit 938bb910dbb40077775781e144229305c203fd0a Author: Justin Burkett Date: Thu Jul 16 13:06:58 2015 -0400 Use string-width instead of length for strings diff --git a/which-key.el b/which-key.el index 1d4ef25c43a..a5b1020915a 100644 --- a/which-key.el +++ b/which-key.el @@ -681,12 +681,12 @@ If KEY contains any \"special keys\" defined in (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 (length key-w-face)))) + (substring key-w-face end (string-width key-w-face)))) key-w-face)))) (defsubst which-key--truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." - (if (> (length desc) which-key-max-description-length) + (if (> (string-width desc) which-key-max-description-length) (concat (substring desc 0 which-key-max-description-length) "..") desc)) @@ -767,7 +767,7 @@ BUFFER that follow the key sequence KEY-SEQ." element in each list element of KEYS." (cl-reduce (lambda (x y) (max x (if (eq (car y) 'status) - 0 (length (substring-no-properties (nth index y)))))) + 0 (string-width (nth index y))))) keys :initial-value 0)) (defun which-key--create-page-vertical (keys max-lines max-width prefix-width) @@ -813,10 +813,10 @@ keys to be written into the upper left porition of the page." (if (eq (car k) 'status) (concat (s-repeat (+ col-key-width col-sep-width) " ") " " (cdr k)) (concat (s-repeat (- col-key-width - (length (substring-no-properties (nth 0 k)))) " ") + (string-width (nth 0 k))) " ") (nth 0 k) " " (nth 1 k) " " (nth 2 k) (s-repeat (- col-desc-width - (length (substring-no-properties (nth 2 k)))) " ")))) + (string-width (nth 2 k))) " ")))) col-keys)) (if (<= col-width avl-width) (progn (push new-column all-columns) @@ -874,7 +874,7 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to (let* ((vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) (prefix-w-face (which-key--propertize-key prefix-keys)) - (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) + (prefix-len (+ 2 (string-width prefix-w-face))) (prefix-string (when which-key-show-prefix (if (eq which-key-show-prefix 'left) (concat prefix-w-face " ") commit 717fe222a49728aec6e38fbbfba465152f964d33 Author: Justin Burkett Date: Thu Jul 16 13:01:41 2015 -0400 Reformat source diff --git a/which-key.el b/which-key.el index ac57514d491..1d4ef25c43a 100644 --- a/which-key.el +++ b/which-key.el @@ -334,7 +334,8 @@ bottom." (error "KEY and REPL should be strings")) (cond ((null alist) (list (cons key repl))) ((assoc-string key alist) - (message "which-key: the key %s already exists in %s. This addition will override that replacement." + (message "which-key: the key %s already exists in %s. This addition \ +will override that replacement." key alist) (setcdr (assoc-string key alist) repl) alist) @@ -409,13 +410,16 @@ character width as the frame." 3))) (defun which-key--char-enlarged-p (&optional frame) - (> (frame-char-width) (/ (float (frame-pixel-width)) (window-total-width (frame-root-window))))) + (> (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))))) + (< (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))))) + (= (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. @@ -709,7 +713,8 @@ removing a \"group:\" prefix." "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))) + (let ((sep-w-face + (propertize which-key-separator 'face 'which-key-separator-face))) (mapcar (lambda (key-desc-cons) (let* ((key (car key-desc-cons)) @@ -749,7 +754,7 @@ BUFFER that follow the key sequence KEY-SEQ." ;; Functions for laying out which-key buffer pages (defsubst which-key--join-columns (columns) - "Transpose columns into rows, concat rows into lines and concat rows into page." + "Transpose columns into rows, concat rows into lines and rows into page." (let* (;; pad reversed columns to same length (padded (apply (apply-partially #'-pad "") (reverse columns))) ;; transpose columns to rows @@ -774,7 +779,9 @@ keys to be written into the upper left porition of the page." (let* ((n-keys (length keys)) (avl-lines max-lines) ;; we get 1 back for not putting a space after the last column - (avl-width (max 0 (- (+ 1 max-width) prefix-width which-key-unicode-correction))) + (avl-width (max 0 (- (+ 1 max-width) + prefix-width + which-key-unicode-correction))) (rem-keys keys) (n-col-lines (min avl-lines n-keys)) (act-n-lines n-col-lines) ; n-col-lines in first column @@ -821,7 +828,8 @@ keys to be written into the upper left porition of the page." (setq page (which-key--join-columns all-columns)) (list page act-n-lines act-width rem-keys (- n-keys (length rem-keys))))) -(defun which-key--create-page (keys max-lines max-width prefix-width &optional vertical use-status-key page-n) +(defun which-key--create-page (keys max-lines max-width prefix-width + &optional vertical use-status-key page-n) "Create a page of KEYS with parameters MAX-LINES, MAX-WIDTH,PREFIX-WIDTH. Use as many keys as possible. Use as few lines as possible unless VERTICAL is non-nil. USE-STATUS-KEY inserts an informative @@ -829,7 +837,8 @@ message in place of the last key on the page if non-nil. PAGE-N allows for the informative message to reference the current page number." (let* ((n-keys (length keys)) - (first-try (which-key--create-page-vertical keys max-lines max-width prefix-width)) + (first-try (which-key--create-page-vertical + keys max-lines max-width prefix-width)) (n-rem-keys (length (nth 3 first-try))) (status-key-i (- n-keys n-rem-keys 1)) (next-try-lines max-lines) @@ -842,7 +851,7 @@ number." (format "%s keys not shown" (1+ n-rem-keys)) 'face 'font-lock-comment-face))) (which-key--create-page-vertical (-insert-at status-key-i status-key keys) - max-lines max-width prefix-width)) + max-lines max-width prefix-width)) ((or vertical (> n-rem-keys 0) (= 1 max-lines)) first-try) ;; do a simple search for the smallest number of lines @@ -881,9 +890,9 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to max-pages-reached) (while (and keys-rem (not max-pages-reached) (not no-room)) (setq page-n (1+ page-n) - page-res (which-key--create-page keys-rem - max-lines avl-width prefix-width - vertical which-key-show-remaining-keys page-n)) + page-res (which-key--create-page + keys-rem max-lines avl-width prefix-width + vertical which-key-show-remaining-keys page-n)) (push page-res pages) (push (if (nth 4 page-res) (nth 4 page-res) 0) keys-per-page) (setq keys-rem (nth 3 page-res) @@ -895,7 +904,8 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to first-page (car pages) first-page-str (concat prefix-string (car first-page))) (cond ((<= (car keys-per-page) 0) ; check first page - (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." prefix-keys) + (message "%s- which-key can't show keys: Settings and/or frame size\ + are too restrictive." prefix-keys) (cons 0 0)) (max-pages-reached (error "Which-key reached the maximum number of pages") commit 4717c8868061c5e6a9449691e486fa25a1b47cf6 Author: Justin Burkett Date: Thu Jul 16 12:27:00 2015 -0400 Move badge below header diff --git a/README.org b/README.org index c1ca7558c0b..810deff70cb 100644 --- a/README.org +++ b/README.org @@ -1,5 +1,5 @@ -[[http://melpa.org/packages/which-key-badge.svg]] * which-key +[[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]] ** Introduction This is a rewrite of [[https://github.com/kai2nenobu/guide-key][guide-key-mode]] for emacs. The intention is to provide the following features: commit 2ef9642d7e36b3a9005d01316474724286487f15 Author: Justin Burkett Date: Thu Jul 16 12:24:37 2015 -0400 Add MELPA badge and change README indentation diff --git a/README.org b/README.org index 3ea0f2cff1f..c1ca7558c0b 100644 --- a/README.org +++ b/README.org @@ -1,4 +1,6 @@ -* which-key Introduction +[[http://melpa.org/packages/which-key-badge.svg]] +* which-key +** Introduction This is a rewrite of [[https://github.com/kai2nenobu/guide-key][guide-key-mode]] for emacs. The intention is to provide the following features: 1. A different polling mechanism to make it lighter on resources than guide-key @@ -10,34 +12,35 @@ following features: 5. A well configured back-end for displaying keys (removing the popwin dependency) that can be easily customized by writing new display functions -* Table of Contents :TOC@4: - - [[#which-key-introduction][which-key Introduction]] - - [[#install][Install]] - - [[#melpa][MELPA]] - - [[#manually][Manually]] - - [[#initial-setup][Initial Setup]] - - [[#minibuffer-option][Minibuffer Option]] - - [[#side-window-right-option][Side Window Right Option]] - - [[#side-window-bottom-option][Side Window Bottom Option]] - - [[#special-features-and-configuration-options][Special Features and Configuration Options]] - - [[#several-popup-types][Several Popup Types]] - - [[#minibuffer][minibuffer]] - - [[#side-window][side window]] - - [[#frame][frame]] - - [[#custom][custom]] - - [[#custom-string-replacement][Custom String Replacement]] - - [[#key-based-replacement]["Key-Based" replacement]] - - [[#key-and-description-replacement][Key and Description replacement]] - - [[#nice-display-with-split-frame][Nice Display with Split Frame]] - - [[#status][Status]] - - [[#thanks][Thanks]] - -* Install -** MELPA +** Table of Contents :TOC@4: + - [[#which-key-][which-key ]] + - [[#introduction][Introduction]] + - [[#install][Install]] + - [[#melpa][MELPA]] + - [[#manually][Manually]] + - [[#initial-setup][Initial Setup]] + - [[#minibuffer-option][Minibuffer Option]] + - [[#side-window-right-option][Side Window Right Option]] + - [[#side-window-bottom-option][Side Window Bottom Option]] + - [[#special-features-and-configuration-options][Special Features and Configuration Options]] + - [[#several-popup-types][Several Popup Types]] + - [[#minibuffer][minibuffer]] + - [[#side-window][side window]] + - [[#frame][frame]] + - [[#custom][custom]] + - [[#custom-string-replacement][Custom String Replacement]] + - [[#key-based-replacement]["Key-Based" replacement]] + - [[#key-and-description-replacement][Key and Description replacement]] + - [[#nice-display-with-split-frame][Nice Display with Split Frame]] + - [[#status][Status]] + - [[#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. -** Manually +*** Manually Add which-key.el to your =load-path= and require. Something like #+BEGIN_SRC emacs-lisp @@ -46,7 +49,7 @@ Add which-key.el to your =load-path= and require. Something like (which-key-mode) #+END_SRC -* Initial Setup +** 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 @@ -68,7 +71,7 @@ There are other substitution abilities included, which are quite flexible (ability to use regexp for example). This makes which-key very customizable. This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacemacs]]. -** Minibuffer Option +*** Minibuffer Option Take over the minibuffer. Setup by default, but you can also use #+BEGIN_SRC emacs-lisp @@ -80,7 +83,7 @@ Take over the minibuffer. Setup by default, but you can also use Note the maximum height of the minibuffer is controlled through the built-in variable =max-mini-window-height=. -** Side Window Right Option +*** Side Window Right Option Popup side window on right. For defaults use #+BEGIN_SRC emacs-lisp @@ -94,7 +97,7 @@ width (see =M-x customize-group which-key=). [[./img/which-key-right.png]] -** Side Window Bottom Option +*** Side Window Bottom Option Popup side window on bottom. For defaults use #+BEGIN_SRC emacs-lisp @@ -103,19 +106,19 @@ Popup side window on bottom. For defaults use [[./img/which-key-bottom.png]] -* Special Features and Configuration Options +** 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=. -** Several Popup Types +*** Several Popup Types 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 +**** minibuffer #+BEGIN_SRC emacs-lisp (setq which-key-popup-type 'minibuffer) #+END_SRC Show keys in the minibuffer. -*** side window +**** side window #+BEGIN_SRC emacs-lisp (setq which-key-popup-type 'side-window) #+END_SRC @@ -134,7 +137,7 @@ Show keys in a side window. This popup type has further options: ;; frame's height (float larger than 0 and smaller than 1) (setq which-key-side-window-max-height 0.25) #+END_SRC -*** frame +**** frame #+BEGIN_SRC emacs-lisp (setq which-key-popup-type 'frame) @@ -150,7 +153,7 @@ further options: (setq which-key-frame-max-height 20) #+END_SRC -*** custom +**** 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 @@ -179,13 +182,13 @@ current implementation of side-window bottom). (quit-windows-on which-key--buffer))) #+END_SRC -** Custom String Replacement +*** Custom String Replacement 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 +**** "Key-Based" replacement The relevant variable is the awkwardly named =which-key-key-based-description-replacement-alist=. In this alist you can have cons cells of two types. An example of the first type is @@ -212,7 +215,7 @@ There are two helper functions to add entries to this list, =which-key-add-major-mode-key-based-replacements=. You can modify the alist directly or use these. -*** Key and Description replacement +**** Key and Description replacement The second and third methods target the text used for the keys and the descriptions directly. The relevant variables are =which-key-key-replacement-alist= and =which-key-description-replacement-alist=. @@ -237,7 +240,7 @@ these alists) (add-to-list 'which-key-key-replacement-alist '("left" . "lft")) #+END_SRC -** Nice Display with Split Frame +*** 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 @@ -246,9 +249,9 @@ windows. #+CAPTION: which-key in a frame with 2 vertical splits [[./img/which-key-bottom-split.png]] -* Status +** Status It requires testing on different platforms with different configurations, which is beyond my capabilities. The default configuration has been reasonably stable for me. -* Thanks +** Thanks Thanks to @bmag for helping with the initial development and finding many bugs. commit 0ae863dd723fd87baa2bc78134eaef7bce044740 Author: Justin Burkett Date: Thu Jul 16 12:24:37 2015 -0400 Add MELPA badge and change README indentation diff --git a/README.org b/README.org index 3ea0f2cff1f..c1ca7558c0b 100644 --- a/README.org +++ b/README.org @@ -1,4 +1,6 @@ -* which-key Introduction +[[http://melpa.org/packages/which-key-badge.svg]] +* which-key +** Introduction This is a rewrite of [[https://github.com/kai2nenobu/guide-key][guide-key-mode]] for emacs. The intention is to provide the following features: 1. A different polling mechanism to make it lighter on resources than guide-key @@ -10,34 +12,35 @@ following features: 5. A well configured back-end for displaying keys (removing the popwin dependency) that can be easily customized by writing new display functions -* Table of Contents :TOC@4: - - [[#which-key-introduction][which-key Introduction]] - - [[#install][Install]] - - [[#melpa][MELPA]] - - [[#manually][Manually]] - - [[#initial-setup][Initial Setup]] - - [[#minibuffer-option][Minibuffer Option]] - - [[#side-window-right-option][Side Window Right Option]] - - [[#side-window-bottom-option][Side Window Bottom Option]] - - [[#special-features-and-configuration-options][Special Features and Configuration Options]] - - [[#several-popup-types][Several Popup Types]] - - [[#minibuffer][minibuffer]] - - [[#side-window][side window]] - - [[#frame][frame]] - - [[#custom][custom]] - - [[#custom-string-replacement][Custom String Replacement]] - - [[#key-based-replacement]["Key-Based" replacement]] - - [[#key-and-description-replacement][Key and Description replacement]] - - [[#nice-display-with-split-frame][Nice Display with Split Frame]] - - [[#status][Status]] - - [[#thanks][Thanks]] - -* Install -** MELPA +** Table of Contents :TOC@4: + - [[#which-key-][which-key ]] + - [[#introduction][Introduction]] + - [[#install][Install]] + - [[#melpa][MELPA]] + - [[#manually][Manually]] + - [[#initial-setup][Initial Setup]] + - [[#minibuffer-option][Minibuffer Option]] + - [[#side-window-right-option][Side Window Right Option]] + - [[#side-window-bottom-option][Side Window Bottom Option]] + - [[#special-features-and-configuration-options][Special Features and Configuration Options]] + - [[#several-popup-types][Several Popup Types]] + - [[#minibuffer][minibuffer]] + - [[#side-window][side window]] + - [[#frame][frame]] + - [[#custom][custom]] + - [[#custom-string-replacement][Custom String Replacement]] + - [[#key-based-replacement]["Key-Based" replacement]] + - [[#key-and-description-replacement][Key and Description replacement]] + - [[#nice-display-with-split-frame][Nice Display with Split Frame]] + - [[#status][Status]] + - [[#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. -** Manually +*** Manually Add which-key.el to your =load-path= and require. Something like #+BEGIN_SRC emacs-lisp @@ -46,7 +49,7 @@ Add which-key.el to your =load-path= and require. Something like (which-key-mode) #+END_SRC -* Initial Setup +** 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 @@ -68,7 +71,7 @@ There are other substitution abilities included, which are quite flexible (ability to use regexp for example). This makes which-key very customizable. This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacemacs]]. -** Minibuffer Option +*** Minibuffer Option Take over the minibuffer. Setup by default, but you can also use #+BEGIN_SRC emacs-lisp @@ -80,7 +83,7 @@ Take over the minibuffer. Setup by default, but you can also use Note the maximum height of the minibuffer is controlled through the built-in variable =max-mini-window-height=. -** Side Window Right Option +*** Side Window Right Option Popup side window on right. For defaults use #+BEGIN_SRC emacs-lisp @@ -94,7 +97,7 @@ width (see =M-x customize-group which-key=). [[./img/which-key-right.png]] -** Side Window Bottom Option +*** Side Window Bottom Option Popup side window on bottom. For defaults use #+BEGIN_SRC emacs-lisp @@ -103,19 +106,19 @@ Popup side window on bottom. For defaults use [[./img/which-key-bottom.png]] -* Special Features and Configuration Options +** 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=. -** Several Popup Types +*** Several Popup Types 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 +**** minibuffer #+BEGIN_SRC emacs-lisp (setq which-key-popup-type 'minibuffer) #+END_SRC Show keys in the minibuffer. -*** side window +**** side window #+BEGIN_SRC emacs-lisp (setq which-key-popup-type 'side-window) #+END_SRC @@ -134,7 +137,7 @@ Show keys in a side window. This popup type has further options: ;; frame's height (float larger than 0 and smaller than 1) (setq which-key-side-window-max-height 0.25) #+END_SRC -*** frame +**** frame #+BEGIN_SRC emacs-lisp (setq which-key-popup-type 'frame) @@ -150,7 +153,7 @@ further options: (setq which-key-frame-max-height 20) #+END_SRC -*** custom +**** 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 @@ -179,13 +182,13 @@ current implementation of side-window bottom). (quit-windows-on which-key--buffer))) #+END_SRC -** Custom String Replacement +*** Custom String Replacement 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 +**** "Key-Based" replacement The relevant variable is the awkwardly named =which-key-key-based-description-replacement-alist=. In this alist you can have cons cells of two types. An example of the first type is @@ -212,7 +215,7 @@ There are two helper functions to add entries to this list, =which-key-add-major-mode-key-based-replacements=. You can modify the alist directly or use these. -*** Key and Description replacement +**** Key and Description replacement The second and third methods target the text used for the keys and the descriptions directly. The relevant variables are =which-key-key-replacement-alist= and =which-key-description-replacement-alist=. @@ -237,7 +240,7 @@ these alists) (add-to-list 'which-key-key-replacement-alist '("left" . "lft")) #+END_SRC -** Nice Display with Split Frame +*** 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 @@ -246,9 +249,9 @@ windows. #+CAPTION: which-key in a frame with 2 vertical splits [[./img/which-key-bottom-split.png]] -* Status +** Status It requires testing on different platforms with different configurations, which is beyond my capabilities. The default configuration has been reasonably stable for me. -* Thanks +** Thanks Thanks to @bmag for helping with the initial development and finding many bugs. commit 46fed20a1a3f1f399e5d4847b6aada8572b56929 Author: Justin Burkett Date: Thu Jul 16 08:09:52 2015 -0400 Add MELPA to install insructions diff --git a/README.org b/README.org index a48ce8f9627..3ea0f2cff1f 100644 --- a/README.org +++ b/README.org @@ -13,6 +13,9 @@ following features: * Table of Contents :TOC@4: - [[#which-key-introduction][which-key Introduction]] - [[#install][Install]] + - [[#melpa][MELPA]] + - [[#manually][Manually]] + - [[#initial-setup][Initial Setup]] - [[#minibuffer-option][Minibuffer Option]] - [[#side-window-right-option][Side Window Right Option]] - [[#side-window-bottom-option][Side Window Bottom Option]] @@ -30,6 +33,11 @@ following features: - [[#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. + +** Manually Add which-key.el to your =load-path= and require. Something like #+BEGIN_SRC emacs-lisp @@ -38,9 +46,12 @@ Add which-key.el to your =load-path= and require. Something like (which-key-mode) #+END_SRC -There are 3 choices of default configs for you to try (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. +* 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 commit 6082e065969050773dede2eaa3ee13ce3718dfb8 Merge: b47f6e7ff2a ac6831fe6d8 Author: Justin Burkett Date: Thu Jul 16 07:53:34 2015 -0400 Merge branch 'master' of https://github.com/justbur/emacs-which-key commit b47f6e7ff2ae025c0ffddb3f615f46ce58b6405b Author: Justin Burkett Date: Thu Jul 16 07:53:05 2015 -0400 Bump version diff --git a/which-key.el b/which-key.el index 566074d722c..4adb9ee6a46 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.2 +;; Version: 0.2.1 ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) commit ac6831fe6d83461226b965173e718737be480c55 Merge: 6d2675a072d 60aec4bbc31 Author: Justin Burkett Date: Thu Jul 16 07:52:08 2015 -0400 Merge pull request #40 from xuchunyang/master Make which-key buffer uninteresting commit 5752d1feb4b452138bd44144df1e1444186f9cfe Author: Justin Burkett Date: Thu Jul 16 07:46:48 2015 -0400 Change echo-keystrokes logic diff --git a/which-key.el b/which-key.el index ebc77bb125f..566074d722c 100644 --- a/which-key.el +++ b/which-key.el @@ -285,14 +285,15 @@ set too high) and setup which-key buffer." (setq which-key--is-setup t)) (defun which-key--setup-echo-keystrokes () - "Initial setup for which-key. -Reduce `echo-keystrokes' if necessary (it will interfer if it's -set too high) and setup which-key buffer." - (when (and (> echo-keystrokes - (+ which-key-echo-keystrokes 0.00001)) - (> which-key-echo-keystrokes 0)) - (setq which-key--echo-keystrokes-backup echo-keystrokes - echo-keystrokes which-key-echo-keystrokes) + "Reduce `echo-keystrokes' if necessary (it will interfer if +it's set too high)." + (when (> (abs (- echo-keystrokes which-key-echo-keystrokes)) 0.000001) + (setq which-key--echo-keystrokes-backup echo-keystrokes) + (if (> which-key-idle-delay which-key-echo-keystrokes) + (setq echo-keystrokes which-key-echo-keystrokes) + (setq which-key-echo-keystrokes + (min echo-keystrokes (/ (float which-key-idle-delay) 4)) + echo-keystrokes which-key-echo-keystrokes)) (message "which-key: echo-keystrokes changed from %s to %s" which-key--echo-keystrokes-backup echo-keystrokes))) commit 60aec4bbc317157e1153c379a1fe4dd16a8d9fc3 Author: Chunyang Xu Date: Thu Jul 16 12:15:28 2015 +0800 Make which-key buffer uninteresting diff --git a/which-key.el b/which-key.el index ebc77bb125f..3a9237c9be5 100644 --- a/which-key.el +++ b/which-key.el @@ -114,7 +114,7 @@ and have `which-key-special-key-face' applied to them." :group 'which-key :type '(repeat string)) -(defcustom which-key-buffer-name "*which-key*" +(defcustom which-key-buffer-name " *which-key*" "Name of which-key buffer." :group 'which-key :type 'string) commit 6d2675a072d92739c2799d20d1848dd352b407fe Author: Justin Burkett Date: Wed Jul 15 22:33:41 2015 -0400 Erase truncate-lines message diff --git a/which-key.el b/which-key.el index 5274f308f1d..ebc77bb125f 100644 --- a/which-key.el +++ b/which-key.el @@ -277,7 +277,8 @@ set too high) and setup which-key buffer." (with-current-buffer which-key--buffer ;; suppress confusing minibuffer message (let (message-log-max) - (toggle-truncate-lines 1)) + (toggle-truncate-lines 1) + (message "")) (setq-local cursor-type nil) (setq-local cursor-in-non-selected-windows nil) (setq-local mode-line-format nil)) commit 9bbbe796b02b89ce113934ebddaad4c1c1689f6e Author: Justin Burkett Date: Wed Jul 15 22:27:14 2015 -0400 Tweak setup breaking out echo-keystrokes stuff diff --git a/which-key.el b/which-key.el index 784e8a67239..5274f308f1d 100644 --- a/which-key.el +++ b/which-key.el @@ -245,7 +245,7 @@ to a non-nil value for the execution of a command. Like this (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 echo-keystrokes +(defvar which-key--echo-keystrokes-backup nil "Internal: Backup the initial value of `echo-keystrokes'.") ;;;###autoload @@ -255,17 +255,7 @@ Used when `which-key-popup-type' is frame.") :lighter " WK" (if which-key-mode (progn - (unless which-key--is-setup - (which-key--setup) - ;; reduce echo-keystrokes for minibuffer popup - ;; (it can interfer if it's too slow) - (when (and (> echo-keystrokes 0) - (eq which-key-popup-type 'minibuffer) - (not (= echo-keystrokes - which-key--echo-keystrokes-backup))) - (setq echo-keystrokes which-key-echo-keystrokes) - (message "which-key: echo-keystrokes changed from %s to %s" - which-key--echo-keystrokes-backup echo-keystrokes))) + (unless which-key--is-setup (which-key--setup)) (add-hook 'pre-command-hook #'which-key--hide-popup) (add-hook 'focus-out-hook #'which-key--stop-open-timer) (add-hook 'focus-in-hook #'which-key--start-open-timer) @@ -278,15 +268,33 @@ Used when `which-key-popup-type' is frame.") (which-key--stop-open-timer))) (defun which-key--setup () - "Create buffer for which-key." + "Initial setup for which-key. +Reduce `echo-keystrokes' if necessary (it will interfer if it's +set too high) and setup which-key buffer." + (when (eq which-key-popup-type 'minibuffer) + (which-key--setup-echo-keystrokes)) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer - (toggle-truncate-lines 1) + ;; suppress confusing minibuffer message + (let (message-log-max) + (toggle-truncate-lines 1)) (setq-local cursor-type nil) (setq-local cursor-in-non-selected-windows nil) (setq-local mode-line-format nil)) (setq which-key--is-setup t)) +(defun which-key--setup-echo-keystrokes () + "Initial setup for which-key. +Reduce `echo-keystrokes' if necessary (it will interfer if it's +set too high) and setup which-key buffer." + (when (and (> echo-keystrokes + (+ which-key-echo-keystrokes 0.00001)) + (> which-key-echo-keystrokes 0)) + (setq which-key--echo-keystrokes-backup echo-keystrokes + echo-keystrokes which-key-echo-keystrokes) + (message "which-key: echo-keystrokes changed from %s to %s" + which-key--echo-keystrokes-backup echo-keystrokes))) + ;; Default configuration functions for use by users. Should be the "best" ;; configurations @@ -311,6 +319,7 @@ bottom." (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)) commit 064e9b3fdec013055c550ad909365ea4f3716a25 Author: Justin Burkett Date: Wed Jul 15 21:56:38 2015 -0400 Cleanup comments diff --git a/which-key.el b/which-key.el index ae19c921d1f..784e8a67239 100644 --- a/which-key.el +++ b/which-key.el @@ -234,7 +234,6 @@ to a non-nil value for the execution of a command. Like this ...\)") ;; Internal Vars -;; (defvar popwin:popup-buffer nil) (defvar which-key--buffer nil "Internal: Holds reference to which-key buffer.") (defvar which-key--window nil @@ -261,7 +260,9 @@ Used when `which-key-popup-type' is frame.") ;; reduce echo-keystrokes for minibuffer popup ;; (it can interfer if it's too slow) (when (and (> echo-keystrokes 0) - (eq which-key-popup-type 'minibuffer)) + (eq which-key-popup-type 'minibuffer) + (not (= echo-keystrokes + which-key--echo-keystrokes-backup))) (setq echo-keystrokes which-key-echo-keystrokes) (message "which-key: echo-keystrokes changed from %s to %s" which-key--echo-keystrokes-backup echo-keystrokes))) @@ -362,9 +363,6 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (if (assq mode which-key-key-based-description-replacement-alist) (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) -;; (setq which-key-key-based-description-replacement-alist - ;; (assq-delete-all mode which-key-key-based-description-replacement-alist)) - ;; (push (cons mode mode-alist) which-key-key-based-description-replacement-alist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for computing window sizes @@ -607,14 +605,15 @@ width) in lines and characters respectively." (cons ;; height (if (member which-key-side-window-location '(left right)) - (- (frame-height) (window-text-height (minibuffer-window)) 1) ;; 1 is a kludge to make sure there is no overlap + ;; 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 (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-side-window-max-width)) (frame-width)))) (defun which-key--frame-max-dimensions () @@ -778,7 +777,8 @@ keys to be written into the upper left porition of the page." (iter-n 0) col-keys col-key-width col-desc-width col-width col-split done new-column page col-sep-width prev-rem-keys) - ;; (message "frame-width %s prefix-width %s avl-width %s max-width %s" (frame-text-cols) prefix-width avl-width max-width) + ;; (message "frame-width %s prefix-width %s avl-width %s max-width %s" + ;; (frame-text-cols) prefix-width avl-width max-width) (while (and (<= iter-n max-iter) (not done)) (setq iter-n (1+ iter-n) col-split (-split-at n-col-lines rem-keys) @@ -834,7 +834,8 @@ number." max-lines max-width prefix-width)) ((or vertical (> n-rem-keys 0) (= 1 max-lines)) first-try) - ;; do a simple search for the smallest number of lines (TODO: Implement binary search) + ;; do a simple search for the smallest number of lines + ;; TODO: Implement binary search (t (while (and (<= iter-n max-iter) (not found)) (setq iter-n (1+ iter-n) prev-try next-try @@ -920,14 +921,11 @@ Finally, show the buffer." (keymapp (lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) (let* ((buf (current-buffer)) - ;; get formatted key bindings (formatted-keys (which-key--get-formatted-key-bindings buf prefix-keys)) - ;; populate target buffer (popup-act-dim (which-key--populate-buffer (key-description prefix-keys) formatted-keys (window-width)))) - ;; show buffer (which-key--show-popup popup-act-dim))))) ;; Timers commit ff3aa9a5a6535d84ba5dbd5c8d8c68583055f694 Author: Justin Burkett Date: Wed Jul 15 21:52:24 2015 -0400 Add another key translation map to check diff --git a/which-key.el b/which-key.el index 3683b39f34c..ae19c921d1f 100644 --- a/which-key.el +++ b/which-key.el @@ -227,7 +227,7 @@ ignored." :type 'function) (defvar which-key-inhibit nil - "Prevent guide-key from popping up momentarily by setting this + "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\)\) @@ -429,7 +429,7 @@ total height." (round (* height-or-percentage (window-total-height (frame-root-window)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Show/hide guide buffer +;; Show/hide which-key buffer (defun which-key--hide-popup () "This function is called to hide the which-key buffer." @@ -915,7 +915,9 @@ Finally, show the buffer." (or (keymapp (key-binding prefix-keys)) ;; Some keymaps are stored here like iso-transl-ctl-x-8-map - (keymapp (lookup-key key-translation-map prefix-keys))) + (keymapp (lookup-key key-translation-map prefix-keys)) + ;; just in case someone uses one of these + (keymapp (lookup-key function-key-map prefix-keys))) (not which-key-inhibit)) (let* ((buf (current-buffer)) ;; get formatted key bindings commit 5c0c3c4bc9c998e9ce81979719ea9a485dcde960 Author: Justin Burkett Date: Wed Jul 15 20:12:09 2015 -0400 Fix #39 `iso-transl-ctl-x-8-map' is not checked with `key-binding' because it's stored in the `key-translation-map', so this adds a test against this map. diff --git a/which-key.el b/which-key.el index f2edf7901c6..3683b39f34c 100644 --- a/which-key.el +++ b/which-key.el @@ -912,7 +912,10 @@ Finally, show the buffer." ;; (when (> (length prefix-keys) 0) ;; (message "key binding: %s" (key-binding prefix-keys))) (when (and (> (length prefix-keys) 0) - (keymapp (key-binding prefix-keys)) + (or + (keymapp (key-binding prefix-keys)) + ;; Some keymaps are stored here like iso-transl-ctl-x-8-map + (keymapp (lookup-key key-translation-map prefix-keys))) (not which-key-inhibit)) (let* ((buf (current-buffer)) ;; get formatted key bindings commit 909ebe487644b8f403e027d7ddfae63b3d441bd8 Author: Justin Burkett Date: Wed Jul 15 14:11:04 2015 -0400 Better notes diff --git a/which-key.el b/which-key.el index d9ca4ac7961..f2edf7901c6 100644 --- a/which-key.el +++ b/which-key.el @@ -263,7 +263,7 @@ Used when `which-key-popup-type' is frame.") (when (and (> echo-keystrokes 0) (eq which-key-popup-type 'minibuffer)) (setq echo-keystrokes which-key-echo-keystrokes) - (message "Which-key: note echo-keystrokes changed from %s to %s" + (message "which-key: echo-keystrokes changed from %s to %s" which-key--echo-keystrokes-backup echo-keystrokes))) (add-hook 'pre-command-hook #'which-key--hide-popup) (add-hook 'focus-out-hook #'which-key--stop-open-timer) @@ -322,7 +322,7 @@ bottom." (error "KEY and REPL should be strings")) (cond ((null alist) (list (cons key repl))) ((assoc-string key alist) - (message "Which-key: note the key %s already exists in %s. This addition will override that replacement." + (message "which-key: the key %s already exists in %s. This addition will override that replacement." key alist) (setcdr (assoc-string key alist) repl) alist) commit abbedca80430738f9837598f675871df4a6532c1 Author: Justin Burkett Date: Wed Jul 15 13:16:21 2015 -0400 Don't show echo-keystroke note more than once Fix #38 diff --git a/which-key.el b/which-key.el index 174a50378b2..d9ca4ac7961 100644 --- a/which-key.el +++ b/which-key.el @@ -256,14 +256,15 @@ Used when `which-key-popup-type' is frame.") :lighter " WK" (if which-key-mode (progn - (unless which-key--is-setup (which-key--setup)) - ;; reduce echo-keystrokes for minibuffer popup - ;; (it can interfer if it's too slow) - (when (and (> echo-keystrokes 0) - (eq which-key-popup-type 'minibuffer)) - (setq echo-keystrokes which-key-echo-keystrokes) - (message "Which-key-mode enabled (note echo-keystrokes changed from %s to %s)" - which-key--echo-keystrokes-backup echo-keystrokes)) + (unless which-key--is-setup + (which-key--setup) + ;; reduce echo-keystrokes for minibuffer popup + ;; (it can interfer if it's too slow) + (when (and (> echo-keystrokes 0) + (eq which-key-popup-type 'minibuffer)) + (setq echo-keystrokes which-key-echo-keystrokes) + (message "Which-key: note echo-keystrokes changed from %s to %s" + which-key--echo-keystrokes-backup echo-keystrokes))) (add-hook 'pre-command-hook #'which-key--hide-popup) (add-hook 'focus-out-hook #'which-key--stop-open-timer) (add-hook 'focus-in-hook #'which-key--start-open-timer) @@ -321,7 +322,7 @@ bottom." (error "KEY and REPL should be strings")) (cond ((null alist) (list (cons key repl))) ((assoc-string key alist) - (message "which-key note: The key %s already exists in %s. This addition will override that replacement." + (message "Which-key: note the key %s already exists in %s. This addition will override that replacement." key alist) (setcdr (assoc-string key alist) repl) alist) commit a640439125e080b600cc75652e71a3e7803b72ac Author: Justin Burkett Date: Wed Jul 15 13:11:12 2015 -0400 Fix typos diff --git a/which-key.el b/which-key.el index 067283a96e0..174a50378b2 100644 --- a/which-key.el +++ b/which-key.el @@ -4,7 +4,7 @@ ;; Author: Justin Burkett ;; URL: https://github.com/justbur/emacs-which-key -;; Version: 0.1 +;; Version: 0.2 ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) @@ -70,7 +70,7 @@ 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 1 means allow for the total extra width +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 commit 742a9039fcd379851c0be3665516f44977e7b598 Author: Justin Burkett Date: Wed Jul 15 10:47:02 2015 -0400 Add ability to temporarily prevent popups diff --git a/which-key.el b/which-key.el index bfc0ff5e5d2..067283a96e0 100644 --- a/which-key.el +++ b/which-key.el @@ -226,6 +226,13 @@ ignored." :group 'which-key :type 'function) +(defvar which-key-inhibit nil + "Prevent guide-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\)\) +...\)") + ;; Internal Vars ;; (defvar popwin:popup-buffer nil) (defvar which-key--buffer nil @@ -904,7 +911,8 @@ Finally, show the buffer." ;; (when (> (length prefix-keys) 0) ;; (message "key binding: %s" (key-binding prefix-keys))) (when (and (> (length prefix-keys) 0) - (keymapp (key-binding prefix-keys))) + (keymapp (key-binding prefix-keys)) + (not which-key-inhibit)) (let* ((buf (current-buffer)) ;; get formatted key bindings (formatted-keys (which-key--get-formatted-key-bindings commit be66556faf84003c9cd190fe370231ac1bc7beeb Author: Justin Burkett Date: Wed Jul 15 09:59:24 2015 -0400 Remove useless when diff --git a/which-key.el b/which-key.el index a72187b3961..bfc0ff5e5d2 100644 --- a/which-key.el +++ b/which-key.el @@ -851,9 +851,9 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to (concat prefix-w-face " ") (concat prefix-w-face "-\n")))) (max-dims (which-key--popup-max-dimensions sel-win-width)) - (max-lines (when (car max-dims) (car max-dims))) + (max-lines (car max-dims)) + (avl-width (cdr max-dims)) (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) - (avl-width (when (cdr max-dims) (cdr max-dims))) (keys-rem formatted-keys) (max-pages (+ 1 (length formatted-keys))) (page-n 0) commit b71d3c239d696aa65f3ef774cf818a18f16d46d9 Merge: cf56764b307 fadd5fda44b Author: Justin Burkett Date: Wed Jul 15 05:45:06 2015 -0400 Merge pull request #36 from syohex/fix-funcall Remove hash quotes commit cf56764b3070d3dad1b07f59ed45842a3673bce1 Merge: 3ab7a2eebb7 84a23465253 Author: Justin Burkett Date: Wed Jul 15 05:30:21 2015 -0400 Merge pull request #37 from purcell/patch-1 Misc formatting fixes commit 84a234652534fecb417265fa777a4345ace51f30 Author: Steve Purcell Date: Wed Jul 15 20:08:24 2015 +1200 Misc formatting fixes - Inline standard license blurb - Define parent of custom group - Insert missing blank lines between top-level declarations diff --git a/which-key.el b/which-key.el index d2cc7372b92..2b7f58ed1d3 100644 --- a/which-key.el +++ b/which-key.el @@ -8,11 +8,23 @@ ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) +;; 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 . + ;;; Commentary: -;; + ;; This is a rewrite of guide-key https://github.com/kai2nenobu/guide-key. See ;; https://github.com/justbur/emacs-which-key for more information. -;; ;;; Code: @@ -20,11 +32,16 @@ (require 's) (require 'dash) -(defgroup which-key nil "Customization options for which-key-mode") +(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." :group 'which-key :type 'float) + (defcustom which-key-echo-keystrokes (min echo-keystrokes (/ (float which-key-idle-delay) 4)) "Value to use for `echo-keystrokes'. @@ -33,15 +50,18 @@ needs to be less than `which-key-idle-delay' or else the 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 \"..\"." :group 'which-key :type 'integer) + (defcustom which-key-separator "→" "Separator to use between key and description." :group 'which-key :type 'string) + (defcustom which-key-unicode-correction 3 "Correction for wide unicode characters. Since we measure width in terms of the number of characters, @@ -57,6 +77,7 @@ 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-key-replacement-alist '(("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") ("left" . "←") ("right" . "→")) "The strings in the car of each cons are replaced with the @@ -64,12 +85,14 @@ strings in the cdr for each key. Elisp regexp can be used as in the first example." :group 'which-key :type '(alist :key-type regexp :value-type string)) + (defcustom which-key-description-replacement-alist '(("Prefix Command" . "prefix")) "See `which-key-key-replacement-alist'. This is a list of lists for replacing descriptions." :group 'which-key :type '(alist :key-type regexp :value-type string)) + (defcustom which-key-key-based-description-replacement-alist '() "Each item in the list is a cons cell. The car of each cons cell is either a string like \"C-c\", in @@ -84,15 +107,18 @@ is overwritten with \"find files\". The second case works the same way using the alist matched when `major-mode' is emacs-lisp-mode." :group 'which-key) + (defcustom which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") "These keys will automatically be truncated to one character and have `which-key-special-key-face' applied to them." :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 'left "Whether to and where to display the current prefix sequence. Possible choices are left (the default), top and nil. Nil turns @@ -101,6 +127,7 @@ the feature off." :type '(radio (const :tag "Left of keys" left) (const :tag "In first line" top) (const :tag "Hide" nil))) + (defcustom which-key-popup-type 'minibuffer "Supported types are minibuffer, side-window, frame, and custom." :group 'which-key @@ -108,6 +135,7 @@ the feature off." (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-side-window-location 'right "Location of which-key popup when `which-key-popup-type' is side-window. Should be one of top, bottom, left or right." @@ -116,6 +144,7 @@ Should be one of top, bottom, left or right." (const bottom) (const left) (const top))) + (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. @@ -123,6 +152,7 @@ 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. @@ -130,14 +160,17 @@ 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-show-remaining-keys t "Show remaining keys in last slot, when keys are hidden." :group 'which-key @@ -149,18 +182,22 @@ a percentage out of the frame's height." '((t . (:inherit font-lock-constant-face))) "Face for which-key keys" :group 'which-key) + (defface which-key-separator-face '((t . (:inherit font-lock-comment-face))) "Face for the separator (default separator is an arrow)" :group 'which-key) + (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) + (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) + (defface which-key-special-key-face '((t . (:inherit which-key-key-face :inverse-video t :weight bold))) "Face for special keys (SPC, TAB, RET)" @@ -174,11 +211,13 @@ 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 . @@ -888,6 +927,7 @@ Finally, show the buffer." (defun which-key--stop-open-timer () "Deactivate idle timer for `which-key--update'." (when which-key--open-timer (cancel-timer which-key--open-timer))) -(provide 'which-key) + +(provide 'which-key) ;;; which-key.el ends here commit fadd5fda44b7359e2921f46882a7d25ec1bcc5e6 Author: Syohei YOSHIDA Date: Wed Jul 15 10:35:13 2015 +0900 Remove hash quotes They are variables, not functions, so hash quotes are not necessary. diff --git a/which-key.el b/which-key.el index d2cc7372b92..42cc1401a13 100644 --- a/which-key.el +++ b/which-key.el @@ -390,7 +390,7 @@ total height." (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)))) + (custom (funcall which-key-custom-hide-popup-function)))) (defun which-key--hide-buffer-minibuffer () "Does nothing. @@ -419,7 +419,7 @@ is shown, or if there is no need to start the closing timer." (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))))) + (custom (funcall which-key-custom-show-popup-function act-popup-dim))))) (defun which-key--show-buffer-minibuffer (act-popup-dim) "Does nothing. @@ -540,7 +540,7 @@ window." (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 selected-window-width)))) + (custom (funcall which-key-custom-popup-max-dimensions-function selected-window-width)))) (defun which-key--minibuffer-max-dimensions () "Return max-dimensions of minibuffer (height . width). commit 3ab7a2eebb7eae9c76745d55876aeed0cd24291a Author: Justin Burkett Date: Tue Jul 14 19:49:43 2015 -0400 Switch to only using dashes for symbol names Matches elisp conventions to the letter diff --git a/README.org b/README.org index e21425814dc..a48ce8f9627 100644 --- a/README.org +++ b/README.org @@ -61,7 +61,7 @@ This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacema Take over the minibuffer. Setup by default, but you can also use #+BEGIN_SRC emacs-lisp -(which-key/setup-minibuffer) +(which-key-setup-minibuffer) #+END_SRC [[./img/which-key-minibuffer.png]] @@ -73,7 +73,7 @@ variable =max-mini-window-height=. Popup side window on right. For defaults use #+BEGIN_SRC emacs-lisp -(which-key/setup-side-window-right) +(which-key-setup-side-window-right) #+END_SRC Note the defaults are fairly conservative and will tend to not display on @@ -87,7 +87,7 @@ width (see =M-x customize-group which-key=). Popup side window on bottom. For defaults use #+BEGIN_SRC emacs-lisp -(which-key/setup-side-window-bottom) +(which-key-setup-side-window-bottom) #+END_SRC [[./img/which-key-bottom.png]] @@ -141,29 +141,29 @@ further options: *** 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 +=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) +(defun which-key-custom-popup-max-dimensions-function (ignore) (cons - (which-key/height-or-percentage-to-height which-key-side-window-max-height) + (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) +(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 () +(defun which-key-custom-hide-popup-function () (when (buffer-live-p which-key--buffer) (quit-windows-on which-key--buffer))) #+END_SRC @@ -197,8 +197,8 @@ type of entries. In case the same key combination is listed under a major-mode and by itself, the major-mode version will take precedence. There are two helper functions to add entries to this list, -=which-key/add-key-based-replacements= and -=which-key/add-major-mode-key-based-replacements=. You can modify the alist +=which-key-add-key-based-replacements= and +=which-key-add-major-mode-key-based-replacements=. You can modify the alist directly or use these. *** Key and Description replacement diff --git a/which-key.el b/which-key.el index c3daaa68d74..d2cc7372b92 100644 --- a/which-key.el +++ b/which-key.el @@ -167,19 +167,19 @@ a percentage out of the frame's height." :group 'which-key) ;; Custom popup -(defcustom which-key/custom-popup-max-dimensions-function nil +(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 +(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 +(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 @@ -210,7 +210,7 @@ Used when `which-key-popup-type' is frame.") :lighter " WK" (if which-key-mode (progn - (unless which-key--is-setup (which-key//setup)) + (unless which-key--is-setup (which-key--setup)) ;; reduce echo-keystrokes for minibuffer popup ;; (it can interfer if it's too slow) (when (and (> echo-keystrokes 0) @@ -218,18 +218,18 @@ Used when `which-key-popup-type' is frame.") (setq echo-keystrokes which-key-echo-keystrokes) (message "Which-key-mode enabled (note echo-keystrokes changed from %s to %s)" which-key--echo-keystrokes-backup echo-keystrokes)) - (add-hook 'pre-command-hook #'which-key//hide-popup) - (add-hook 'focus-out-hook #'which-key//stop-open-timer) - (add-hook 'focus-in-hook #'which-key//start-open-timer) - (which-key//start-open-timer)) + (add-hook 'pre-command-hook #'which-key--hide-popup) + (add-hook 'focus-out-hook #'which-key--stop-open-timer) + (add-hook 'focus-in-hook #'which-key--start-open-timer) + (which-key--start-open-timer)) ;; make sure echo-keystrokes returns to original value (setq echo-keystrokes which-key--echo-keystrokes-backup) - (remove-hook 'pre-command-hook #'which-key//hide-popup) - (remove-hook 'focus-out-hook #'which-key//stop-open-timer) - (remove-hook 'focus-in-hook #'which-key//start-open-timer) - (which-key//stop-open-timer))) + (remove-hook 'pre-command-hook #'which-key--hide-popup) + (remove-hook 'focus-out-hook #'which-key--stop-open-timer) + (remove-hook 'focus-in-hook #'which-key--start-open-timer) + (which-key--stop-open-timer))) -(defun which-key//setup () +(defun which-key--setup () "Create buffer for which-key." (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer @@ -243,7 +243,7 @@ Used when `which-key-popup-type' is frame.") ;; configurations ;;;###autoload -(defun which-key/setup-side-window-right () +(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 @@ -251,7 +251,7 @@ Used when `which-key-popup-type' is frame.") which-key-show-prefix 'top)) ;;;###autoload -(defun which-key/setup-side-window-bottom () +(defun which-key-setup-side-window-bottom () "Apply suggested settings for side-window that opens on bottom." (interactive) @@ -260,7 +260,7 @@ bottom." which-key-show-prefix nil)) ;;;###autoload -(defun which-key/setup-minibuffer () +(defun which-key-setup-minibuffer () "Apply suggested settings for minibuffer." (interactive) (setq which-key-popup-type 'minibuffer @@ -269,7 +269,7 @@ bottom." ;; Helper functions to modify replacement lists. -(defun which-key//add-key-based-replacements (alist key repl) +(defun which-key--add-key-based-replacements (alist key repl) "Internal function to add (KEY . REPL) to ALIST." (when (or (not (stringp key)) (not (stringp repl))) (error "KEY and REPL should be strings")) @@ -282,11 +282,11 @@ bottom." (t (cons (cons key repl) alist)))) ;;;###autoload -(defun which-key/add-key-based-replacements (key-sequence replacement &rest more) +(defun which-key-add-key-based-replacements (key-sequence replacement &rest more) "Replace the description of KEY-SEQUENCE with REPLACEMENT. Both KEY-SEQUENCE and REPLACEMENT should be strings. For Example, -\(which-key/add-key-based-replacements \"C-x 1\" \"maximize\"\) +\(which-key-add-key-based-replacements \"C-x 1\" \"maximize\"\) MORE allows you to specifcy additional KEY REPL pairs. All replacements are added to @@ -294,14 +294,14 @@ replacements are added to ;; TODO: Make interactive (while key-sequence (setq which-key-key-based-description-replacement-alist - (which-key//add-key-based-replacements + (which-key--add-key-based-replacements which-key-key-based-description-replacement-alist key-sequence replacement)) (setq key-sequence (pop more) replacement (pop more)))) ;;;###autoload -(defun which-key/add-major-mode-key-based-replacements (mode key-sequence replacement &rest more) - "Functions like `which-key/add-key-based-replacements'. +(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." @@ -310,7 +310,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." (error "MODE should be a symbol corresponding to a value of major-mode")) (let ((mode-alist (cdr (assq mode which-key-key-based-description-replacement-alist)))) (while key-sequence - (setq mode-alist (which-key//add-key-based-replacements mode-alist key-sequence replacement)) + (setq mode-alist (which-key--add-key-based-replacements mode-alist key-sequence replacement)) (setq key-sequence (pop more) replacement (pop more))) (if (assq mode which-key-key-based-description-replacement-alist) (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) @@ -322,7 +322,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for computing window sizes -(defun which-key//text-width-to-total (text-width) +(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 @@ -334,11 +334,11 @@ width as the frame." (+ text-width (/ (frame-fringe-width) char-width) (/ (frame-scroll-bar-width) char-width) - (if (which-key//char-enlarged-p) 1 0) + (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) +(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 @@ -348,20 +348,20 @@ character width as the frame." (- total-width (/ (frame-fringe-width) char-width) (/ (frame-scroll-bar-width) char-width) - (if (which-key//char-enlarged-p) 1 0) + (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) +(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) +(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) +(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) +(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. @@ -371,7 +371,7 @@ total width." width-or-percentage (round (* width-or-percentage (window-total-width (frame-root-window)))))) -(defun which-key//height-or-percentage-to-height (height-or-percentage) +(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. @@ -384,59 +384,59 @@ total height." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Show/hide guide buffer -(defun which-key//hide-popup () +(defun which-key--hide-popup () "This function is called to hide the which-key buffer." (cl-case which-key-popup-type - (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)))) + (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-buffer-minibuffer () +(defun which-key--hide-buffer-minibuffer () "Does nothing. Stub for consistency with other hide-buffer functions." nil) -(defun which-key//hide-buffer-side-window () +(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 () +(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//show-popup (act-popup-dim) +(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 - (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))))) + (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//show-buffer-minibuffer (act-popup-dim) +(defun which-key--show-buffer-minibuffer (act-popup-dim) "Does nothing. Stub for consistency with other show-buffer functions." nil) -(defun which-key//fit-buffer-to-window-horizontally (&optional window &rest params) +(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) +(defun which-key--show-buffer-side-window (_act-popup-dim) "Show which-key buffer when popup type is side-window." (let* ((side which-key-side-window-location) - (alist '((window-width . which-key//fit-buffer-to-window-horizontally) + (alist '((window-width . which-key--fit-buffer-to-window-horizontally) (window-height . fit-window-to-buffer)))) ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' ;; were added in Emacs 24.3 @@ -457,7 +457,7 @@ call signature in different emacs versions" (display-buffer-reuse-window which-key--buffer alist) (display-buffer-in-major-side-window which-key--buffer side 0 alist)))) -(defun which-key//show-buffer-frame (act-popup-dim) +(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) @@ -473,15 +473,15 @@ call signature in different emacs versions" (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)))) + (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'." +(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 @@ -504,8 +504,8 @@ call signature in different emacs versions" (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'." +(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))))) @@ -515,7 +515,7 @@ call signature in different emacs versions" window))) ;; Keep for popwin maybe (Used to work) -;; (defun which-key/show-buffer-popwin (height width) +;; (defun which-key-show-buffer-popwin (height width) ;; "Using popwin popup buffer with dimensions HEIGHT and WIDTH." ;; (popwin:popup-buffer which-key-buffer-name ;; :height height @@ -523,7 +523,7 @@ call signature in different emacs versions" ;; :noselect t ;; :position which-key-side-window-location)) -;; (defun which-key/hide-buffer-popwin () +;; (defun which-key-hide-buffer-popwin () ;; "Hide popwin buffer." ;; (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) ;; (popwin:close-popup-window))) @@ -531,18 +531,18 @@ call signature in different emacs versions" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Max dimension of available window functions -(defun which-key//popup-max-dimensions (selected-window-width) +(defun which-key--popup-max-dimensions (selected-window-width) "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 selected-window-width)))) + (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 selected-window-width)))) -(defun which-key//minibuffer-max-dimensions () +(defun which-key--minibuffer-max-dimensions () "Return max-dimensions of minibuffer (height . width). Measured in lines and characters respectively." (cons @@ -554,7 +554,7 @@ Measured in lines and characters respectively." ;; width (frame-text-cols))) -(defun which-key//side-window-max-dimensions () +(defun which-key--side-window-max-dimensions () "Return max-dimensions of the side-window popup (height . width) in lines and characters respectively." (cons @@ -563,14 +563,14 @@ width) in lines and characters respectively." (- (frame-height) (window-text-height (minibuffer-window)) 1) ;; 1 is a kludge to make sure there is no overlap ;; (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)) + (which-key--height-or-percentage-to-height which-key-side-window-max-height)) ;; width (if (member which-key-side-window-location '(left right)) - (which-key//total-width-to-text (which-key//width-or-percentage-to-width + (which-key--total-width-to-text (which-key--width-or-percentage-to-width which-key-side-window-max-width)) (frame-width)))) -(defun which-key//frame-max-dimensions () +(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)) @@ -578,7 +578,7 @@ width) in lines and characters respectively." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for retrieving and formatting keys -(defun which-key//maybe-replace (string repl-alist &optional literal) +(defun which-key--maybe-replace (string repl-alist &optional literal) "Perform replacements on STRING. REPL-ALIST is an alist where the car of each element is the text to replace and the cdr is the replacement text. Unless LITERAL is @@ -592,7 +592,7 @@ replacement occurs return the new STRING." (replace-match (cdr repl) t literal new-string)))) new-string))) -(defun which-key//maybe-replace-key-based (string keys) +(defun which-key--maybe-replace-key-based (string keys) "KEYS is a key sequence like \"C-c C-c\" and STRING is the description that is possibly replaced using the `which-key-key-based-description-replacement-alist'. Whether or @@ -605,7 +605,7 @@ not a replacement occurs return the new STRING." (str-res (cdr str-res)) (t string)))) -(defun which-key//propertize-key (key) +(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 @@ -623,17 +623,17 @@ If KEY contains any \"special keys\" defined in (substring key-w-face end (length key-w-face)))) key-w-face)))) -(defsubst which-key//truncate-description (desc) +(defsubst which-key--truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." (if (> (length desc) which-key-max-description-length) (concat (substring desc 0 which-key-max-description-length) "..") desc)) -(defsubst which-key//group-p (description) +(defsubst which-key--group-p (description) (or (string-match-p "^\\(group:\\|Prefix\\)" description) (keymapp (intern description)))) -(defun which-key//propertize-description (description group) +(defun which-key--propertize-description (description group) "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 @@ -642,13 +642,13 @@ removing a \"group:\" prefix." (desc (if (string-match-p "^group:" desc) (substring desc 6) desc)) (desc (if group (concat "+" desc) desc)) - (desc (which-key//truncate-description desc))) + (desc (which-key--truncate-description desc))) (propertize desc 'face (if group 'which-key-group-description-face 'which-key-command-description-face)))) -(defun which-key//format-and-replace (unformatted prefix-keys) +(defun which-key--format-and-replace (unformatted prefix-keys) "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)." @@ -657,19 +657,19 @@ alists. Returns a list (key separator description)." (lambda (key-desc-cons) (let* ((key (car key-desc-cons)) (desc (cdr key-desc-cons)) - (group (which-key//group-p desc)) + (group (which-key--group-p desc)) (keys (concat prefix-keys " " key)) - (key (which-key//maybe-replace + (key (which-key--maybe-replace key which-key-key-replacement-alist)) - (desc (which-key//maybe-replace + (desc (which-key--maybe-replace desc which-key-description-replacement-alist)) - (desc (which-key//maybe-replace-key-based desc keys)) - (key-w-face (which-key//propertize-key key)) - (desc-w-face (which-key//propertize-description desc group))) + (desc (which-key--maybe-replace-key-based desc keys)) + (key-w-face (which-key--propertize-key key)) + (desc-w-face (which-key--propertize-description desc group))) (list key-w-face sep-w-face desc-w-face))) unformatted))) -(defun which-key//get-formatted-key-bindings (buffer key-seq) +(defun which-key--get-formatted-key-bindings (buffer key-seq) "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." (let ((key-str-qt (regexp-quote (key-description key-seq))) @@ -686,12 +686,12 @@ BUFFER that follow the key sequence KEY-SEQ." desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted :test (lambda (x y) (string-equal (car x) (car y)))))) - (which-key//format-and-replace unformatted (key-description key-seq)))) + (which-key--format-and-replace unformatted (key-description key-seq)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for laying out which-key buffer pages -(defsubst which-key//join-columns (columns) +(defsubst which-key--join-columns (columns) "Transpose columns into rows, concat rows into lines and concat rows into page." (let* (;; pad reversed columns to same length (padded (apply (apply-partially #'-pad "") (reverse columns))) @@ -700,7 +700,7 @@ BUFFER that follow the key sequence KEY-SEQ." ;; join lines by space and rows by newline (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n"))) -(defsubst which-key//max-len (keys index) +(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 @@ -708,7 +708,7 @@ element in each list element of KEYS." 0 (length (substring-no-properties (nth index y)))))) keys :initial-value 0)) -(defun which-key//create-page-vertical (keys max-lines max-width prefix-width) +(defun which-key--create-page-vertical (keys max-lines max-width prefix-width) "Format KEYS into string representing a single page of text. Creates columns (padded to be of uniform width) of length MAX-LINES until keys run out or MAX-WIDTH is reached. A non-zero @@ -739,9 +739,9 @@ keys to be written into the upper left porition of the page." prev-rem-keys rem-keys rem-keys (cadr col-split) n-col-lines (min avl-lines (length rem-keys)) - col-key-width (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-key-width (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 (+ 3 col-key-width col-sep-width col-desc-width) new-column (mapcar (lambda (k) @@ -760,10 +760,10 @@ keys to be written into the upper left porition of the page." (setq done t rem-keys prev-rem-keys)) (when (<= (length rem-keys) 0) (setq done t))) - (setq page (which-key//join-columns all-columns)) + (setq page (which-key--join-columns all-columns)) (list page act-n-lines act-width rem-keys (- n-keys (length rem-keys))))) -(defun which-key//create-page (keys max-lines max-width prefix-width &optional vertical use-status-key page-n) +(defun which-key--create-page (keys max-lines max-width prefix-width &optional vertical use-status-key page-n) "Create a page of KEYS with parameters MAX-LINES, MAX-WIDTH,PREFIX-WIDTH. Use as many keys as possible. Use as few lines as possible unless VERTICAL is non-nil. USE-STATUS-KEY inserts an informative @@ -771,7 +771,7 @@ message in place of the last key on the page if non-nil. PAGE-N allows for the informative message to reference the current page number." (let* ((n-keys (length keys)) - (first-try (which-key//create-page-vertical keys max-lines max-width prefix-width)) + (first-try (which-key--create-page-vertical keys max-lines max-width prefix-width)) (n-rem-keys (length (nth 3 first-try))) (status-key-i (- n-keys n-rem-keys 1)) (next-try-lines max-lines) @@ -783,7 +783,7 @@ number." (cons 'status (propertize (format "%s keys not shown" (1+ n-rem-keys)) 'face 'font-lock-comment-face))) - (which-key//create-page-vertical (-insert-at status-key-i status-key keys) + (which-key--create-page-vertical (-insert-at status-key-i status-key keys) max-lines max-width prefix-width)) ((or vertical (> n-rem-keys 0) (= 1 max-lines)) first-try) @@ -792,26 +792,26 @@ number." (setq iter-n (1+ iter-n) prev-try next-try next-try-lines (- next-try-lines 1) - next-try (which-key//create-page-vertical + next-try (which-key--create-page-vertical keys next-try-lines max-width prefix-width) n-rem-keys (length (nth 3 next-try)) found (or (= next-try-lines 0) (> n-rem-keys 0)))) prev-try)))) -(defun which-key//populate-buffer (prefix-keys formatted-keys sel-win-width) +(defun which-key--populate-buffer (prefix-keys formatted-keys sel-win-width) "Insert FORMATTED-KEYS into which-key buffer. PREFIX-KEYS may be inserted into the buffer depending on the value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to -`which-key//popup-max-dimensions'." +`which-key--popup-max-dimensions'." (let* ((vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) - (prefix-w-face (which-key//propertize-key prefix-keys)) + (prefix-w-face (which-key--propertize-key prefix-keys)) (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) (prefix-string (when which-key-show-prefix (if (eq which-key-show-prefix 'left) (concat prefix-w-face " ") (concat prefix-w-face "-\n")))) - (max-dims (which-key//popup-max-dimensions sel-win-width)) + (max-dims (which-key--popup-max-dimensions sel-win-width)) (max-lines (when (car max-dims) (car max-dims))) (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) (avl-width (when (cdr max-dims) (cdr max-dims))) @@ -822,7 +822,7 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to max-pages-reached) (while (and keys-rem (not max-pages-reached) (not no-room)) (setq page-n (1+ page-n) - page-res (which-key//create-page keys-rem + page-res (which-key--create-page keys-rem max-lines avl-width prefix-width vertical which-key-show-remaining-keys page-n)) (push page-res pages) @@ -856,7 +856,7 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update -(defun which-key//update () +(defun which-key--update () "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." (let ((prefix-keys (this-single-command-keys))) @@ -868,25 +868,25 @@ Finally, show the buffer." (keymapp (key-binding prefix-keys))) (let* ((buf (current-buffer)) ;; get formatted key bindings - (formatted-keys (which-key//get-formatted-key-bindings + (formatted-keys (which-key--get-formatted-key-bindings buf prefix-keys)) ;; populate target buffer - (popup-act-dim (which-key//populate-buffer + (popup-act-dim (which-key--populate-buffer (key-description prefix-keys) formatted-keys (window-width)))) ;; show buffer - (which-key//show-popup popup-act-dim))))) + (which-key--show-popup popup-act-dim))))) ;; Timers -(defun which-key//start-open-timer () - "Activate idle timer to trigger `which-key//update'." - (which-key//stop-open-timer) ; start over +(defun which-key--start-open-timer () + "Activate idle timer to trigger `which-key--update'." + (which-key--stop-open-timer) ; start over (setq which-key--open-timer - (run-with-idle-timer which-key-idle-delay t 'which-key//update))) + (run-with-idle-timer which-key-idle-delay t 'which-key--update))) -(defun which-key//stop-open-timer () - "Deactivate idle timer for `which-key//update'." +(defun which-key--stop-open-timer () + "Deactivate idle timer for `which-key--update'." (when which-key--open-timer (cancel-timer which-key--open-timer))) (provide 'which-key) commit 73dbd7482665a799427e411d8cc82d21de6aca45 Merge: c1b5b6bc100 bf4ce9f8678 Author: Justin Burkett Date: Tue Jul 14 15:00:25 2015 -0400 Merge branch 'master' of https://github.com/justbur/emacs-which-key commit c1b5b6bc100e7070d1036a097813afb6c29472a2 Author: Justin Burkett Date: Tue Jul 14 14:59:48 2015 -0400 Be consistent with use of double slash diff --git a/which-key.el b/which-key.el index 167de9b4d86..c3daaa68d74 100644 --- a/which-key.el +++ b/which-key.el @@ -210,7 +210,7 @@ Used when `which-key-popup-type' is frame.") :lighter " WK" (if which-key-mode (progn - (unless which-key--is-setup (which-key/setup)) + (unless which-key--is-setup (which-key//setup)) ;; reduce echo-keystrokes for minibuffer popup ;; (it can interfer if it's too slow) (when (and (> echo-keystrokes 0) @@ -218,18 +218,18 @@ Used when `which-key-popup-type' is frame.") (setq echo-keystrokes which-key-echo-keystrokes) (message "Which-key-mode enabled (note echo-keystrokes changed from %s to %s)" which-key--echo-keystrokes-backup echo-keystrokes)) - (add-hook 'pre-command-hook #'which-key/hide-popup) - (add-hook 'focus-out-hook #'which-key/stop-open-timer) - (add-hook 'focus-in-hook #'which-key/start-open-timer) - (which-key/start-open-timer)) + (add-hook 'pre-command-hook #'which-key//hide-popup) + (add-hook 'focus-out-hook #'which-key//stop-open-timer) + (add-hook 'focus-in-hook #'which-key//start-open-timer) + (which-key//start-open-timer)) ;; make sure echo-keystrokes returns to original value (setq echo-keystrokes which-key--echo-keystrokes-backup) - (remove-hook 'pre-command-hook #'which-key/hide-popup) - (remove-hook 'focus-out-hook #'which-key/stop-open-timer) - (remove-hook 'focus-in-hook #'which-key/start-open-timer) - (which-key/stop-open-timer))) + (remove-hook 'pre-command-hook #'which-key//hide-popup) + (remove-hook 'focus-out-hook #'which-key//stop-open-timer) + (remove-hook 'focus-in-hook #'which-key//start-open-timer) + (which-key//stop-open-timer))) -(defun which-key/setup () +(defun which-key//setup () "Create buffer for which-key." (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer @@ -322,7 +322,7 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for computing window sizes -(defun which-key/text-width-to-total (text-width) +(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 @@ -334,11 +334,11 @@ width as the frame." (+ text-width (/ (frame-fringe-width) char-width) (/ (frame-scroll-bar-width) char-width) - (if (which-key/char-enlarged-p) 1 0) + (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) +(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 @@ -348,20 +348,20 @@ character width as the frame." (- total-width (/ (frame-fringe-width) char-width) (/ (frame-scroll-bar-width) char-width) - (if (which-key/char-enlarged-p) 1 0) + (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) +(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) +(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) +(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) +(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. @@ -371,7 +371,7 @@ total width." width-or-percentage (round (* width-or-percentage (window-total-width (frame-root-window)))))) -(defun which-key/height-or-percentage-to-height (height-or-percentage) +(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. @@ -384,59 +384,59 @@ total height." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Show/hide guide buffer -(defun which-key/hide-popup () +(defun which-key//hide-popup () "This function is called to hide the which-key buffer." (cl-case which-key-popup-type - (minibuffer (which-key/hide-buffer-minibuffer)) - (side-window (which-key/hide-buffer-side-window)) - (frame (which-key/hide-buffer-frame)) + (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-buffer-minibuffer () +(defun which-key//hide-buffer-minibuffer () "Does nothing. Stub for consistency with other hide-buffer functions." nil) -(defun which-key/hide-buffer-side-window () +(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 () +(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/show-popup (act-popup-dim) +(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 - (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)) + (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/show-buffer-minibuffer (act-popup-dim) +(defun which-key//show-buffer-minibuffer (act-popup-dim) "Does nothing. Stub for consistency with other show-buffer functions." nil) -(defun which-key/fit-buffer-to-window-horizontally (&optional window &rest params) +(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) +(defun which-key//show-buffer-side-window (_act-popup-dim) "Show which-key buffer when popup type is side-window." (let* ((side which-key-side-window-location) - (alist '((window-width . which-key/fit-buffer-to-window-horizontally) + (alist '((window-width . which-key//fit-buffer-to-window-horizontally) (window-height . fit-window-to-buffer)))) ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' ;; were added in Emacs 24.3 @@ -457,7 +457,7 @@ call signature in different emacs versions" (display-buffer-reuse-window which-key--buffer alist) (display-buffer-in-major-side-window which-key--buffer side 0 alist)))) -(defun which-key/show-buffer-frame (act-popup-dim) +(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) @@ -473,15 +473,15 @@ call signature in different emacs versions" (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)))) + (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'." +(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 @@ -504,8 +504,8 @@ call signature in different emacs versions" (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'." +(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))))) @@ -531,18 +531,18 @@ call signature in different emacs versions" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Max dimension of available window functions -(defun which-key/popup-max-dimensions (selected-window-width) +(defun which-key//popup-max-dimensions (selected-window-width) "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)) + (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 selected-window-width)))) -(defun which-key/minibuffer-max-dimensions () +(defun which-key//minibuffer-max-dimensions () "Return max-dimensions of minibuffer (height . width). Measured in lines and characters respectively." (cons @@ -554,7 +554,7 @@ Measured in lines and characters respectively." ;; width (frame-text-cols))) -(defun which-key/side-window-max-dimensions () +(defun which-key//side-window-max-dimensions () "Return max-dimensions of the side-window popup (height . width) in lines and characters respectively." (cons @@ -563,14 +563,14 @@ width) in lines and characters respectively." (- (frame-height) (window-text-height (minibuffer-window)) 1) ;; 1 is a kludge to make sure there is no overlap ;; (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)) + (which-key//height-or-percentage-to-height which-key-side-window-max-height)) ;; width (if (member which-key-side-window-location '(left right)) - (which-key/total-width-to-text (which-key/width-or-percentage-to-width + (which-key//total-width-to-text (which-key//width-or-percentage-to-width which-key-side-window-max-width)) (frame-width)))) -(defun which-key/frame-max-dimensions () +(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)) @@ -578,7 +578,7 @@ width) in lines and characters respectively." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for retrieving and formatting keys -(defun which-key/maybe-replace (string repl-alist &optional literal) +(defun which-key//maybe-replace (string repl-alist &optional literal) "Perform replacements on STRING. REPL-ALIST is an alist where the car of each element is the text to replace and the cdr is the replacement text. Unless LITERAL is @@ -592,7 +592,7 @@ replacement occurs return the new STRING." (replace-match (cdr repl) t literal new-string)))) new-string))) -(defun which-key/maybe-replace-key-based (string keys) +(defun which-key//maybe-replace-key-based (string keys) "KEYS is a key sequence like \"C-c C-c\" and STRING is the description that is possibly replaced using the `which-key-key-based-description-replacement-alist'. Whether or @@ -605,7 +605,7 @@ not a replacement occurs return the new STRING." (str-res (cdr str-res)) (t string)))) -(defun which-key/propertize-key (key) +(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 @@ -623,7 +623,7 @@ If KEY contains any \"special keys\" defined in (substring key-w-face end (length key-w-face)))) key-w-face)))) -(defsubst which-key/truncate-description (desc) +(defsubst which-key//truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." (if (> (length desc) which-key-max-description-length) (concat (substring desc 0 which-key-max-description-length) "..") @@ -633,7 +633,7 @@ If KEY contains any \"special keys\" defined in (or (string-match-p "^\\(group:\\|Prefix\\)" description) (keymapp (intern description)))) -(defun which-key/propertize-description (description group) +(defun which-key//propertize-description (description group) "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 @@ -642,13 +642,13 @@ removing a \"group:\" prefix." (desc (if (string-match-p "^group:" desc) (substring desc 6) desc)) (desc (if group (concat "+" desc) desc)) - (desc (which-key/truncate-description desc))) + (desc (which-key//truncate-description desc))) (propertize desc 'face (if group 'which-key-group-description-face 'which-key-command-description-face)))) -(defun which-key/format-and-replace (unformatted prefix-keys) +(defun which-key//format-and-replace (unformatted prefix-keys) "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)." @@ -659,17 +659,17 @@ alists. Returns a list (key separator description)." (desc (cdr key-desc-cons)) (group (which-key//group-p desc)) (keys (concat prefix-keys " " key)) - (key (which-key/maybe-replace + (key (which-key//maybe-replace key which-key-key-replacement-alist)) - (desc (which-key/maybe-replace + (desc (which-key//maybe-replace desc which-key-description-replacement-alist)) - (desc (which-key/maybe-replace-key-based desc keys)) - (key-w-face (which-key/propertize-key key)) - (desc-w-face (which-key/propertize-description desc group))) + (desc (which-key//maybe-replace-key-based desc keys)) + (key-w-face (which-key//propertize-key key)) + (desc-w-face (which-key//propertize-description desc group))) (list key-w-face sep-w-face desc-w-face))) unformatted))) -(defun which-key/get-formatted-key-bindings (buffer key-seq) +(defun which-key//get-formatted-key-bindings (buffer key-seq) "Uses `describe-buffer-bindings' to collect the key bindings in BUFFER that follow the key sequence KEY-SEQ." (let ((key-str-qt (regexp-quote (key-description key-seq))) @@ -686,7 +686,7 @@ BUFFER that follow the key sequence KEY-SEQ." desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted :test (lambda (x y) (string-equal (car x) (car y)))))) - (which-key/format-and-replace unformatted (key-description key-seq)))) + (which-key//format-and-replace unformatted (key-description key-seq)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for laying out which-key buffer pages @@ -708,7 +708,7 @@ element in each list element of KEYS." 0 (length (substring-no-properties (nth index y)))))) keys :initial-value 0)) -(defun which-key/create-page-vertical (keys max-lines max-width prefix-width) +(defun which-key//create-page-vertical (keys max-lines max-width prefix-width) "Format KEYS into string representing a single page of text. Creates columns (padded to be of uniform width) of length MAX-LINES until keys run out or MAX-WIDTH is reached. A non-zero @@ -763,7 +763,7 @@ keys to be written into the upper left porition of the page." (setq page (which-key//join-columns all-columns)) (list page act-n-lines act-width rem-keys (- n-keys (length rem-keys))))) -(defun which-key/create-page (keys max-lines max-width prefix-width &optional vertical use-status-key page-n) +(defun which-key//create-page (keys max-lines max-width prefix-width &optional vertical use-status-key page-n) "Create a page of KEYS with parameters MAX-LINES, MAX-WIDTH,PREFIX-WIDTH. Use as many keys as possible. Use as few lines as possible unless VERTICAL is non-nil. USE-STATUS-KEY inserts an informative @@ -771,7 +771,7 @@ message in place of the last key on the page if non-nil. PAGE-N allows for the informative message to reference the current page number." (let* ((n-keys (length keys)) - (first-try (which-key/create-page-vertical keys max-lines max-width prefix-width)) + (first-try (which-key//create-page-vertical keys max-lines max-width prefix-width)) (n-rem-keys (length (nth 3 first-try))) (status-key-i (- n-keys n-rem-keys 1)) (next-try-lines max-lines) @@ -783,7 +783,7 @@ number." (cons 'status (propertize (format "%s keys not shown" (1+ n-rem-keys)) 'face 'font-lock-comment-face))) - (which-key/create-page-vertical (-insert-at status-key-i status-key keys) + (which-key//create-page-vertical (-insert-at status-key-i status-key keys) max-lines max-width prefix-width)) ((or vertical (> n-rem-keys 0) (= 1 max-lines)) first-try) @@ -792,26 +792,26 @@ number." (setq iter-n (1+ iter-n) prev-try next-try next-try-lines (- next-try-lines 1) - next-try (which-key/create-page-vertical + next-try (which-key//create-page-vertical keys next-try-lines max-width prefix-width) n-rem-keys (length (nth 3 next-try)) found (or (= next-try-lines 0) (> n-rem-keys 0)))) prev-try)))) -(defun which-key/populate-buffer (prefix-keys formatted-keys sel-win-width) +(defun which-key//populate-buffer (prefix-keys formatted-keys sel-win-width) "Insert FORMATTED-KEYS into which-key buffer. PREFIX-KEYS may be inserted into the buffer depending on the value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to -`which-key/popup-max-dimensions'." +`which-key//popup-max-dimensions'." (let* ((vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) - (prefix-w-face (which-key/propertize-key prefix-keys)) + (prefix-w-face (which-key//propertize-key prefix-keys)) (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) (prefix-string (when which-key-show-prefix (if (eq which-key-show-prefix 'left) (concat prefix-w-face " ") (concat prefix-w-face "-\n")))) - (max-dims (which-key/popup-max-dimensions sel-win-width)) + (max-dims (which-key//popup-max-dimensions sel-win-width)) (max-lines (when (car max-dims) (car max-dims))) (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) (avl-width (when (cdr max-dims) (cdr max-dims))) @@ -822,7 +822,7 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to max-pages-reached) (while (and keys-rem (not max-pages-reached) (not no-room)) (setq page-n (1+ page-n) - page-res (which-key/create-page keys-rem + page-res (which-key//create-page keys-rem max-lines avl-width prefix-width vertical which-key-show-remaining-keys page-n)) (push page-res pages) @@ -856,7 +856,7 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update -(defun which-key/update () +(defun which-key//update () "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." (let ((prefix-keys (this-single-command-keys))) @@ -868,25 +868,25 @@ Finally, show the buffer." (keymapp (key-binding prefix-keys))) (let* ((buf (current-buffer)) ;; get formatted key bindings - (formatted-keys (which-key/get-formatted-key-bindings + (formatted-keys (which-key//get-formatted-key-bindings buf prefix-keys)) ;; populate target buffer - (popup-act-dim (which-key/populate-buffer + (popup-act-dim (which-key//populate-buffer (key-description prefix-keys) formatted-keys (window-width)))) ;; show buffer - (which-key/show-popup popup-act-dim))))) + (which-key//show-popup popup-act-dim))))) ;; Timers -(defun which-key/start-open-timer () - "Activate idle timer to trigger `which-key/update'." - (which-key/stop-open-timer) ; start over +(defun which-key//start-open-timer () + "Activate idle timer to trigger `which-key//update'." + (which-key//stop-open-timer) ; start over (setq which-key--open-timer - (run-with-idle-timer which-key-idle-delay t 'which-key/update))) + (run-with-idle-timer which-key-idle-delay t 'which-key//update))) -(defun which-key/stop-open-timer () - "Deactivate idle timer for `which-key/update'." +(defun which-key//stop-open-timer () + "Deactivate idle timer for `which-key//update'." (when which-key--open-timer (cancel-timer which-key--open-timer))) (provide 'which-key) commit bf4ce9f8678aa30162efd9468d4453fa6fc0754d Merge: c0569471e35 19fa37e1a47 Author: Justin Burkett Date: Tue Jul 14 14:06:22 2015 -0400 Merge pull request #34 from bmag/master Updated images for split frame commit 19fa37e1a47fa715c002fa8d8f54c47bf980c940 Author: Bar Magal Date: Tue Jul 14 21:02:40 2015 +0300 Updated images for split frame diff --git a/img/which-key-bottom-split.png b/img/which-key-bottom-split.png index b1d1de9f2c7..a13057e330c 100644 Binary files a/img/which-key-bottom-split.png and b/img/which-key-bottom-split.png differ diff --git a/img/which-key-right-split.png b/img/which-key-right-split.png index 944293fd939..581ae68bd58 100644 Binary files a/img/which-key-right-split.png and b/img/which-key-right-split.png differ commit c0569471e35f12c0e3274949a33dbddce854a257 Author: Justin Burkett Date: Tue Jul 14 12:43:55 2015 -0400 Typo in readme diff --git a/README.org b/README.org index 0139a50ea9f..e21425814dc 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,6 @@ * which-key Introduction -This is of [[https://github.com/kai2nenobu/guide-key][guide-key-mode]] for emacs. The intention is to provide the following -features: +This is a rewrite of [[https://github.com/kai2nenobu/guide-key][guide-key-mode]] for emacs. The intention is to provide the +following features: 1. A different polling mechanism to make it lighter on resources than guide-key 2. An improved display of keys with more keys being shown by default and a nicer presentation commit fc6fd2d920904c59bbbfd36e701537f91cec00b2 Author: Justin Burkett Date: Tue Jul 14 12:21:11 2015 -0400 Fix url in header diff --git a/which-key.el b/which-key.el index e998d5bfc19..167de9b4d86 100644 --- a/which-key.el +++ b/which-key.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2015 Justin Burkett ;; Author: Justin Burkett -;; URL: https://github.com/justbur/which-key +;; URL: https://github.com/justbur/emacs-which-key ;; Version: 0.1 ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) @@ -11,7 +11,7 @@ ;;; Commentary: ;; ;; This is a rewrite of guide-key https://github.com/kai2nenobu/guide-key. See -;; https://github.com/justbur/which-key for more information. +;; https://github.com/justbur/emacs-which-key for more information. ;; ;;; Code: commit fe07489d5d24c24f869057faeb9a49e119955ba4 Author: Justin Burkett Date: Tue Jul 14 12:06:03 2015 -0400 flycheck-package fixes diff --git a/which-key.el b/which-key.el index a3ec4f2e15e..e998d5bfc19 100644 --- a/which-key.el +++ b/which-key.el @@ -46,13 +46,13 @@ Also adds \"..\"." "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 +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 1 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 +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 @@ -109,8 +109,8 @@ the feature off." (const :tag "Show in popup frame" frame) (const :tag "Use your custom display functions" custom))) (defcustom which-key-side-window-location 'right - "Location of which-key popup when `which-key-popup-type' is -side-window. Should be one of top, bottom, left or right." + "Location of which-key popup when `which-key-popup-type' is side-window. +Should be one of top, bottom, left or right." :group 'which-key :type '(radio (const right) (const bottom) @@ -182,7 +182,7 @@ It takes no arguments and the return value is ignored." (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 +width) in lines and characters respectively. The return value is ignored." :group 'which-key :type 'function) @@ -282,31 +282,36 @@ bottom." (t (cons (cons key repl) alist)))) ;;;###autoload -(defun which-key/add-key-based-replacements (key repl &rest more) - "Replace the description of a key sequence KEY (e.g., \"C-c -C-c\") with REPL. Both KEY and REPL should be strings. MORE -allows you to specifcy additional KEY REPL pairs. All +(defun which-key/add-key-based-replacements (key-sequence replacement &rest more) + "Replace the description of KEY-SEQUENCE with REPLACEMENT. +Both KEY-SEQUENCE and REPLACEMENT should be strings. For Example, + +\(which-key/add-key-based-replacements \"C-x 1\" \"maximize\"\) + +MORE allows you to specifcy additional KEY REPL pairs. All replacements are added to `which-key-key-based-description-replacement-alist'." ;; TODO: Make interactive - (while key + (while key-sequence (setq which-key-key-based-description-replacement-alist (which-key//add-key-based-replacements - which-key-key-based-description-replacement-alist key repl)) - (setq key (pop more) repl (pop more)))) + which-key-key-based-description-replacement-alist + key-sequence replacement)) + (setq key-sequence (pop more) replacement (pop more)))) ;;;###autoload -(defun which-key/add-major-mode-key-based-replacements (mode key repl &rest more) - "Functions like `which-key/add-key-based-replacements' with the -exception that KEY and REPL (MORE contains addition KEY REPL -pairs) will only apply when the major-mode MODE is active." +(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 (cdr (assq mode which-key-key-based-description-replacement-alist)))) - (while key - (setq mode-alist (which-key//add-key-based-replacements mode-alist key repl)) - (setq key (pop more) repl (pop more))) + (while key-sequence + (setq mode-alist (which-key//add-key-based-replacements mode-alist key-sequence replacement)) + (setq key-sequence (pop more) replacement (pop more))) (if (assq mode which-key-key-based-description-replacement-alist) (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) @@ -319,11 +324,12 @@ pairs) will only apply when the major-mode MODE is active." (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." +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) @@ -334,9 +340,9 @@ the frame." (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 +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 @@ -357,7 +363,7 @@ character width as the frame." (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 +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." @@ -367,7 +373,7 @@ total width." (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 +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." @@ -387,8 +393,8 @@ total height." (custom (funcall #'which-key/custom-hide-popup-function)))) (defun which-key/hide-buffer-minibuffer () - "Does nothing. Stub for consistency with other hide-buffer -functions." + "Does nothing. +Stub for consistency with other hide-buffer functions." nil) (defun which-key/hide-buffer-side-window () @@ -404,10 +410,10 @@ functions." (delete-frame which-key--frame))) (defun which-key/show-popup (act-popup-dim) - "Show guide window. 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." + "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 (minibuffer (which-key/show-buffer-minibuffer act-popup-dim)) @@ -416,19 +422,19 @@ need to start the closing timer." (custom (funcall #'which-key/custom-show-popup-function act-popup-dim))))) (defun which-key/show-buffer-minibuffer (act-popup-dim) - "Does nothing. Stub for consistency with other show-buffer -functions." + "Does nothing. +Stub for consistency with other show-buffer functions." nil) (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" + "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" + "Show which-key buffer when popup type is side-window." (let* ((side which-key-side-window-location) (alist '((window-width . which-key/fit-buffer-to-window-horizontally) (window-height . fit-window-to-buffer)))) @@ -452,7 +458,7 @@ signature in different emacs versions" (display-buffer-in-major-side-window which-key--buffer side 0 alist)))) (defun which-key/show-buffer-frame (act-popup-dim) - "Show which-key buffer when popup type is frame" + "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 @@ -475,7 +481,7 @@ signature in different emacs versions" new-window))) (defun which-key/show-buffer-new-frame (frame-height frame-width) - "Helper for `which-key/show-buffer-frame'" + "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 @@ -499,7 +505,7 @@ signature in different emacs versions" new-window))) (defun which-key/show-buffer-reuse-frame (frame-height frame-width) - "Helper for `which-key/show-buffer-frame'" + "Helper for `which-key/show-buffer-frame'." (let ((window (display-buffer-reuse-window which-key--buffer `((reusable-frames . ,which-key--frame))))) @@ -537,8 +543,8 @@ window." (custom (funcall #'which-key/custom-popup-max-dimensions-function selected-window-width)))) (defun which-key/minibuffer-max-dimensions () - "Return max-dimensions of minibuffer (height . width) in lines -and characters respectively." + "Return max-dimensions of minibuffer (height . width). +Measured in lines and characters respectively." (cons ;; height (if (floatp max-mini-window-height) @@ -575,8 +581,8 @@ width) in lines and characters respectively." (defun which-key/maybe-replace (string repl-alist &optional literal) "Perform replacements on STRING. REPL-ALIST is an alist where the car of each element is the text -to replace and the cdr is the replacement text. Unless LITERAL is -non-nil regexp is used in the replacements. Whether or not a +to replace and the cdr is the replacement text. Unless LITERAL is +non-nil regexp is used in the replacements. Whether or not a replacement occurs return the new STRING." (save-match-data (let ((new-string string)) @@ -600,9 +606,10 @@ not a replacement occurs return the new STRING." (t string)))) (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'." + "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 @@ -616,6 +623,12 @@ corresponding `which-key-special-key-face'." (substring key-w-face end (length key-w-face)))) key-w-face)))) +(defsubst which-key/truncate-description (desc) + "Truncate DESC description to `which-key-max-description-length'." + (if (> (length desc) which-key-max-description-length) + (concat (substring desc 0 which-key-max-description-length) "..") + desc)) + (defsubst which-key//group-p (description) (or (string-match-p "^\\(group:\\|Prefix\\)" description) (keymapp (intern description)))) @@ -635,12 +648,6 @@ removing a \"group:\" prefix." 'which-key-group-description-face 'which-key-command-description-face)))) -(defsubst which-key/truncate-description (desc) - "Truncate DESC description to `which-key-max-description-length'." - (if (> (length desc) which-key-max-description-length) - (concat (substring desc 0 which-key-max-description-length) "..") - desc)) - (defun which-key/format-and-replace (unformatted prefix-keys) "Take a list of (key . desc) cons cells in UNFORMATTED, add faces and perform replacements according to the three replacement commit 3e9f4762953e331d76524040e8ca69acd38293b1 Author: Justin Burkett Date: Tue Jul 14 11:45:09 2015 -0400 Reorg the readme and add key features to intro diff --git a/README.org b/README.org index d287cf0a63b..0139a50ea9f 100644 --- a/README.org +++ b/README.org @@ -1,8 +1,17 @@ -* which-key -Rewrite of guide-key-mode for emacs. +* which-key Introduction +This is of [[https://github.com/kai2nenobu/guide-key][guide-key-mode]] for emacs. The intention is to provide the following +features: +1. A different polling mechanism to make it lighter on resources than guide-key +2. An improved display of keys with more keys being shown by default and a nicer + presentation +3. Customization options that allow for the rewriting of command names on the + fly through easily modifiable alists +4. Good default configurations that work well with most themes +5. A well configured back-end for displaying keys (removing the popwin + dependency) that can be easily customized by writing new display functions * Table of Contents :TOC@4: - - [[#which-key][which-key]] + - [[#which-key-introduction][which-key Introduction]] - [[#install][Install]] - [[#minibuffer-option][Minibuffer Option]] - [[#side-window-right-option][Side Window Right Option]] @@ -17,10 +26,8 @@ Rewrite of guide-key-mode for emacs. - [[#key-based-replacement]["Key-Based" replacement]] - [[#key-and-description-replacement][Key and Description replacement]] - [[#nice-display-with-split-frame][Nice Display with Split Frame]] - - [[#statusgoals][Status/Goals]] - - [[#stability][Stability]] - - [[#completed-goals][Completed Goals]] - - [[#incomplete-and-planned][Incomplete and Planned]] + - [[#status][Status]] + - [[#thanks][Thanks]] * Install Add which-key.el to your =load-path= and require. Something like @@ -228,21 +235,9 @@ windows. #+CAPTION: which-key in a frame with 2 vertical splits [[./img/which-key-bottom-split.png]] -* Status/Goals -** Stability -It's very much a work in progress, so expect weird things to happen from time to -time. That being said, the default configuration works well for me. -** Completed Goals -1. Use idle timers to trigger window popup instead of guide-key's constant - polling. -2. Remove popwin as a "hard" dependency, preferring built-in display commands - where possible. -3. Add support for replacement lists to modify key descriptions on the fly. - Currently you can replace in the key or description field using regexp, and - using a key sequence (like =C-x 1=) to fully replace the description (the - latter can target major modes, too). -** Incomplete and Planned -1. Come up with creative ways to fit more keys in buffer while still maintaining - nice alignment and formatting. Such as - 1. Automatic text scaling - 2. Paging functionality +* Status +It requires testing on different platforms with different configurations, which +is beyond my capabilities. The default configuration has been reasonably stable +for me. +* Thanks +Thanks to @bmag for helping with the initial development and finding many bugs. commit 1b55f62024b1ee1de1e9fb576e6fb8a72155c174 Author: Justin Burkett Date: Tue Jul 14 09:26:52 2015 -0400 Cleanup replacement functions again diff --git a/which-key.el b/which-key.el index 19528b82bf2..a3ec4f2e15e 100644 --- a/which-key.el +++ b/which-key.el @@ -273,16 +273,13 @@ bottom." "Internal function to add (KEY . REPL) to ALIST." (when (or (not (stringp key)) (not (stringp repl))) (error "KEY and REPL should be strings")) - (if alist - (progn - (if (assoc-string key alist) - (progn - (message "which-key note: The key %s already exists in %s. This addition will override that replacement." - key alist) - (setcdr (assoc-string key alist) repl)) - (push (cons key repl) alist))) - (setq alist (list (cons key repl)))) - alist) + (cond ((null alist) (list (cons key repl))) + ((assoc-string key alist) + (message "which-key note: The key %s already exists in %s. This addition will override that replacement." + key alist) + (setcdr (assoc-string key alist) repl) + alist) + (t (cons (cons key repl) alist)))) ;;;###autoload (defun which-key/add-key-based-replacements (key repl &rest more) @@ -308,9 +305,7 @@ pairs) will only apply when the major-mode MODE is active." (error "MODE should be a symbol corresponding to a value of major-mode")) (let ((mode-alist (cdr (assq mode which-key-key-based-description-replacement-alist)))) (while key - (if mode-alist - (setq mode-alist (which-key//add-key-based-replacements mode-alist key repl)) - (setq mode-alist (list (cons key repl)))) + (setq mode-alist (which-key//add-key-based-replacements mode-alist key repl)) (setq key (pop more) repl (pop more))) (if (assq mode which-key-key-based-description-replacement-alist) (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) commit a1b88958da69d5504623d86902780af55cb204eb Author: Justin Burkett Date: Tue Jul 14 08:46:16 2015 -0400 Fix add-replacement functions Also cleanup use of push in code diff --git a/which-key.el b/which-key.el index 0d6a8fe64d3..19528b82bf2 100644 --- a/which-key.el +++ b/which-key.el @@ -273,10 +273,15 @@ bottom." "Internal function to add (KEY . REPL) to ALIST." (when (or (not (stringp key)) (not (stringp repl))) (error "KEY and REPL should be strings")) - (when (assoc-string key alist) - (message "which-key note: The key %s already exists in %s. This addition will override that replacement." - key alist)) - (setq alist (push (cons key repl) alist)) + (if alist + (progn + (if (assoc-string key alist) + (progn + (message "which-key note: The key %s already exists in %s. This addition will override that replacement." + key alist) + (setcdr (assoc-string key alist) repl)) + (push (cons key repl) alist))) + (setq alist (list (cons key repl)))) alist) ;;;###autoload @@ -303,14 +308,16 @@ pairs) will only apply when the major-mode MODE is active." (error "MODE should be a symbol corresponding to a value of major-mode")) (let ((mode-alist (cdr (assq mode which-key-key-based-description-replacement-alist)))) (while key - (setq mode-alist (which-key//add-key-based-replacements - mode-alist key repl)) + (if mode-alist + (setq mode-alist (which-key//add-key-based-replacements mode-alist key repl)) + (setq mode-alist (list (cons key repl)))) (setq key (pop more) repl (pop more))) - (setq which-key-key-based-description-replacement-alist - (assq-delete-all mode which-key-key-based-description-replacement-alist) - which-key-key-based-description-replacement-alist - (push (cons mode mode-alist) - which-key-key-based-description-replacement-alist)))) + (if (assq mode which-key-key-based-description-replacement-alist) + (setcdr (assq mode which-key-key-based-description-replacement-alist) mode-alist) + (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) +;; (setq which-key-key-based-description-replacement-alist + ;; (assq-delete-all mode which-key-key-based-description-replacement-alist)) + ;; (push (cons mode mode-alist) which-key-key-based-description-replacement-alist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for computing window sizes @@ -745,9 +752,9 @@ keys to be written into the upper left porition of the page." (length (substring-no-properties (nth 2 k)))) " ")))) col-keys)) (if (<= col-width avl-width) - (setq all-columns (push new-column all-columns) - act-width (+ act-width col-width) - avl-width (- avl-width col-width)) + (progn (push new-column all-columns) + (setq act-width (+ act-width col-width) + avl-width (- avl-width col-width))) (setq done t rem-keys prev-rem-keys)) (when (<= (length rem-keys) 0) (setq done t))) @@ -815,10 +822,10 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to (setq page-n (1+ page-n) page-res (which-key/create-page keys-rem max-lines avl-width prefix-width - vertical which-key-show-remaining-keys page-n) - pages (push page-res pages) - keys-per-page (push (if (nth 4 page-res) (nth 4 page-res) 0) keys-per-page) - keys-rem (nth 3 page-res) + vertical which-key-show-remaining-keys page-n)) + (push page-res pages) + (push (if (nth 4 page-res) (nth 4 page-res) 0) keys-per-page) + (setq keys-rem (nth 3 page-res) no-room (<= (car keys-per-page) 0) max-pages-reached (>= page-n max-pages))) ;; not doing anything with other pages for now commit e286290667271f4d6728918fe0df9057e970a0c6 Author: Justin Burkett Date: Tue Jul 14 07:41:00 2015 -0400 Fix #33 Check for group before replacements occur diff --git a/which-key.el b/which-key.el index 4d89a7d1e73..0d6a8fe64d3 100644 --- a/which-key.el +++ b/which-key.el @@ -614,17 +614,18 @@ corresponding `which-key-special-key-face'." (substring key-w-face end (length key-w-face)))) key-w-face)))) -(defun which-key/propertize-description (description) +(defsubst which-key//group-p (description) + (or (string-match-p "^\\(group:\\|Prefix\\)" description) + (keymapp (intern description)))) + +(defun which-key/propertize-description (description group) "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." (let* ((desc description) - (group-prfx (string-match-p "^group:" desc)) - (group (or group-prfx - (keymapp (intern desc)) - (string-match-p "^Prefix" desc))) - (desc (if group-prfx (substring desc 6) desc)) + (desc (if (string-match-p "^group:" desc) + (substring desc 6) desc)) (desc (if group (concat "+" desc) desc)) (desc (which-key/truncate-description desc))) (propertize desc 'face @@ -647,6 +648,7 @@ alists. Returns a list (key separator description)." (lambda (key-desc-cons) (let* ((key (car key-desc-cons)) (desc (cdr key-desc-cons)) + (group (which-key//group-p desc)) (keys (concat prefix-keys " " key)) (key (which-key/maybe-replace key which-key-key-replacement-alist)) @@ -654,7 +656,7 @@ alists. Returns a list (key separator description)." desc which-key-description-replacement-alist)) (desc (which-key/maybe-replace-key-based desc keys)) (key-w-face (which-key/propertize-key key)) - (desc-w-face (which-key/propertize-description desc))) + (desc-w-face (which-key/propertize-description desc group))) (list key-w-face sep-w-face desc-w-face))) unformatted))) commit 8ce3f967022d0d365ab7dc7ab05dd66a7e40f9d6 Author: Justin Burkett Date: Mon Jul 13 15:22:41 2015 -0400 New default pictures diff --git a/img/which-key-bottom.png b/img/which-key-bottom.png index 9ed2bf1090a..00d372aef06 100644 Binary files a/img/which-key-bottom.png and b/img/which-key-bottom.png differ diff --git a/img/which-key-minibuffer.png b/img/which-key-minibuffer.png index 586920aed44..0ce5263b14d 100644 Binary files a/img/which-key-minibuffer.png and b/img/which-key-minibuffer.png differ diff --git a/img/which-key-right.png b/img/which-key-right.png index f01a40bc453..7342863c801 100644 Binary files a/img/which-key-right.png and b/img/which-key-right.png differ commit 01da1c59785cd065bab2c43de20e3670dd5f5bac Author: Justin Burkett Date: Mon Jul 13 15:13:43 2015 -0400 Convert custom functions to defcustom diff --git a/which-key.el b/which-key.el index 3ef4615dc19..4d89a7d1e73 100644 --- a/which-key.el +++ b/which-key.el @@ -167,19 +167,25 @@ a percentage out of the frame's height." :group 'which-key) ;; Custom popup -(defvar which-key/custom-popup-max-dimensions-function nil +(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).") -(defvar which-key/custom-hide-popup-function nil +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.") -(defvar which-key/custom-show-popup-function nil +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.") +ignored." + :group 'which-key + :type 'function) ;; Internal Vars ;; (defvar popwin:popup-buffer nil) commit 5e1187f49b7efa4e736c838abb1262dca9d4158b Author: Justin Burkett Date: Mon Jul 13 14:59:07 2015 -0400 Fix weird no room error diff --git a/which-key.el b/which-key.el index 92d82f044d0..3ef4615dc19 100644 --- a/which-key.el +++ b/which-key.el @@ -818,7 +818,7 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to pages (reverse pages) first-page (car pages) first-page-str (concat prefix-string (car first-page))) - (cond (no-room + (cond ((<= (car keys-per-page) 0) ; check first page (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." prefix-keys) (cons 0 0)) (max-pages-reached commit c945a9676876798fa0b909582547ad1fdd540482 Author: Justin Burkett Date: Mon Jul 13 11:23:25 2015 -0400 Autoloads for helper functions diff --git a/which-key.el b/which-key.el index 133833b84e4..92d82f044d0 100644 --- a/which-key.el +++ b/which-key.el @@ -273,6 +273,7 @@ bottom." (setq alist (push (cons key repl) alist)) alist) +;;;###autoload (defun which-key/add-key-based-replacements (key repl &rest more) "Replace the description of a key sequence KEY (e.g., \"C-c C-c\") with REPL. Both KEY and REPL should be strings. MORE @@ -286,6 +287,7 @@ replacements are added to which-key-key-based-description-replacement-alist key repl)) (setq key (pop more) repl (pop more)))) +;;;###autoload (defun which-key/add-major-mode-key-based-replacements (mode key repl &rest more) "Functions like `which-key/add-key-based-replacements' with the exception that KEY and REPL (MORE contains addition KEY REPL commit e1a03e6a336a58e8d1b9c87086959bc444897249 Author: Justin Burkett Date: Mon Jul 13 11:21:52 2015 -0400 Remove defaults related to outside packages diff --git a/which-key.el b/which-key.el index a08d71c4821..133833b84e4 100644 --- a/which-key.el +++ b/which-key.el @@ -65,13 +65,9 @@ in the first example." :group 'which-key :type '(alist :key-type regexp :value-type string)) (defcustom which-key-description-replacement-alist - '(("Prefix Command" . "prefix") - ("select-window-\\([1-9]\\)" . "Window \\1")) + '(("Prefix Command" . "prefix")) "See `which-key-key-replacement-alist'. -This is a list of lists for replacing descriptions. The second -one removes \"namespace/\" from \"namespace/function\". This is a -convention for naming functions but not a rule, so remove this -replacement if it becomes problematic." +This is a list of lists for replacing descriptions." :group 'which-key :type '(alist :key-type regexp :value-type string)) (defcustom which-key-key-based-description-replacement-alist '() @@ -104,7 +100,7 @@ the feature off." :group 'which-key :type '(radio (const :tag "Left of keys" left) (const :tag "In first line" top) - (const :tag "Hide" nil))) + (const :tag "Hide" nil))) (defcustom which-key-popup-type 'minibuffer "Supported types are minibuffer, side-window, frame, and custom." :group 'which-key commit 3d3f5727a584a8d5099f9042b1724b7530370d51 Author: Justin Burkett Date: Mon Jul 13 08:59:39 2015 -0400 Minor change to previous refactor diff --git a/which-key.el b/which-key.el index 04cf13d1319..a08d71c4821 100644 --- a/which-key.el +++ b/which-key.el @@ -678,8 +678,8 @@ BUFFER that follow the key sequence KEY-SEQ." (defsubst which-key//join-columns (columns) "Transpose columns into rows, concat rows into lines and concat rows into page." - (let* (;; pad columns to same length and reverse order - (padded (reverse (apply (apply-partially #'-pad "") columns))) + (let* (;; pad reversed columns to same length + (padded (apply (apply-partially #'-pad "") (reverse columns))) ;; transpose columns to rows (rows (apply #'cl-mapcar #'list padded))) ;; join lines by space and rows by newline commit 13406f7e4140c33932cc468c4e44ac9b2b66906f Author: Justin Burkett Date: Mon Jul 13 08:39:08 2015 -0400 Refactor column layout diff --git a/which-key.el b/which-key.el index 9e7fa890ff2..04cf13d1319 100644 --- a/which-key.el +++ b/which-key.el @@ -676,6 +676,15 @@ BUFFER that follow the key sequence KEY-SEQ." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for laying out which-key buffer pages +(defsubst which-key//join-columns (columns) + "Transpose columns into rows, concat rows into lines and concat rows into page." + (let* (;; pad columns to same length and reverse order + (padded (reverse (apply (apply-partially #'-pad "") columns))) + ;; transpose columns to rows + (rows (apply #'cl-mapcar #'list padded))) + ;; join lines by space and rows by newline + (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." @@ -697,6 +706,7 @@ keys to be written into the upper left porition of the page." (rem-keys keys) (n-col-lines (min avl-lines n-keys)) (act-n-lines n-col-lines) ; n-col-lines in first column + ;; Initial column for prefix (if used) (all-columns (list (mapcar (lambda (i) (if (> i 1) (s-repeat prefix-width " ") "")) @@ -705,7 +715,7 @@ keys to be written into the upper left porition of the page." (max-iter 100) (iter-n 0) col-keys col-key-width col-desc-width col-width col-split done - n-columns new-column page col-sep-width prev-rem-keys) + new-column page col-sep-width prev-rem-keys) ;; (message "frame-width %s prefix-width %s avl-width %s max-width %s" (frame-text-cols) prefix-width avl-width max-width) (while (and (<= iter-n max-iter) (not done)) (setq iter-n (1+ iter-n) @@ -735,13 +745,7 @@ keys to be written into the upper left porition of the page." (setq done t rem-keys prev-rem-keys)) (when (<= (length rem-keys) 0) (setq done t))) - (setq all-columns (reverse all-columns) - n-columns (length all-columns)) - (dotimes (i act-n-lines) - (dotimes (j n-columns) - (setq page (concat page (nth i (nth j all-columns)) - (if (not (= j (- n-columns 1))) " " - (when (not (= i (- act-n-lines 1))) "\n")))))) + (setq page (which-key//join-columns all-columns)) (list page act-n-lines act-width rem-keys (- n-keys (length rem-keys))))) (defun which-key/create-page (keys max-lines max-width prefix-width &optional vertical use-status-key page-n) commit 10298abc507f6604c58be26454f57bf83683ea30 Author: Justin Burkett Date: Mon Jul 13 07:54:16 2015 -0400 Fix a message diff --git a/which-key.el b/which-key.el index e66e789379a..9e7fa890ff2 100644 --- a/which-key.el +++ b/which-key.el @@ -272,7 +272,8 @@ bottom." (when (or (not (stringp key)) (not (stringp repl))) (error "KEY and REPL should be strings")) (when (assoc-string key alist) - (message "which-key note: The key %s already exists in %s. This addition will override that replacement.")) + (message "which-key note: The key %s already exists in %s. This addition will override that replacement." + key alist)) (setq alist (push (cons key repl) alist)) alist) commit f91238ac7af99d0bbd4db9abd23a778c47150e02 Author: Justin Burkett Date: Sun Jul 12 22:03:17 2015 -0400 Remove some old code diff --git a/which-key.el b/which-key.el index 8d1f0391d36..e66e789379a 100644 --- a/which-key.el +++ b/which-key.el @@ -637,8 +637,7 @@ removing a \"group:\" prefix." "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 ((max-key-width 0) - (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face))) + (let ((sep-w-face (propertize which-key-separator 'face 'which-key-separator-face))) (mapcar (lambda (key-desc-cons) (let* ((key (car key-desc-cons)) @@ -650,9 +649,7 @@ alists. Returns a list (key separator description)." desc which-key-description-replacement-alist)) (desc (which-key/maybe-replace-key-based desc keys)) (key-w-face (which-key/propertize-key key)) - (desc-w-face (which-key/propertize-description desc)) - (key-width (length (substring-no-properties key-w-face)))) - (setq max-key-width (max key-width max-key-width)) + (desc-w-face (which-key/propertize-description desc))) (list key-w-face sep-w-face desc-w-face))) unformatted))) commit ce4561c617536fdbbb5f6b16d600c266cb2cdbe8 Author: Justin Burkett Date: Sun Jul 12 21:58:26 2015 -0400 Add docstring for propertize-description diff --git a/which-key.el b/which-key.el index 330b31ed1c7..8d1f0391d36 100644 --- a/which-key.el +++ b/which-key.el @@ -610,6 +610,10 @@ corresponding `which-key-special-key-face'." key-w-face)))) (defun which-key/propertize-description (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." (let* ((desc description) (group-prfx (string-match-p "^group:" desc)) (group (or group-prfx commit 6ca581959319c8f737407036e0d8b1d165190b85 Author: Justin Burkett Date: Sun Jul 12 21:24:36 2015 -0400 Move unicode-correction and bump default to 3 diff --git a/which-key.el b/which-key.el index c31166677c6..330b31ed1c7 100644 --- a/which-key.el +++ b/which-key.el @@ -42,7 +42,7 @@ Also adds \"..\"." "Separator to use between key and description." :group 'which-key :type 'string) -(defcustom which-key-unicode-correction 1 +(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 @@ -193,7 +193,7 @@ ignored.") "Internal: Holds reference to which-key window.") (defvar which-key--open-timer nil "Internal: Holds reference to open window timer.") -(defvar which-key--setup-p nil +(defvar which-key--is-setup nil "Internal: Non-nil if which-key buffer has been setup.") (defvar which-key--frame nil "Internal: Holds reference to which-key frame. @@ -208,7 +208,7 @@ Used when `which-key-popup-type' is frame.") :lighter " WK" (if which-key-mode (progn - (unless which-key--setup-p (which-key/setup)) + (unless which-key--is-setup (which-key/setup)) ;; reduce echo-keystrokes for minibuffer popup ;; (it can interfer if it's too slow) (when (and (> echo-keystrokes 0) @@ -235,7 +235,7 @@ Used when `which-key-popup-type' is frame.") (setq-local cursor-type nil) (setq-local cursor-in-non-selected-windows nil) (setq-local mode-line-format nil)) - (setq which-key--setup-p t)) + (setq which-key--is-setup t)) ;; Default configuration functions for use by users. Should be the "best" ;; configurations @@ -690,7 +690,8 @@ PREFIX-WIDTH adds padding on the left side to allow for prefix keys to be written into the upper left porition of the page." (let* ((n-keys (length keys)) (avl-lines max-lines) - (avl-width (- (+ 1 max-width) prefix-width)); we get 1 back for not putting a space after the last column + ;; we get 1 back for not putting a space after the last column + (avl-width (max 0 (- (+ 1 max-width) prefix-width which-key-unicode-correction))) (rem-keys keys) (n-col-lines (min avl-lines n-keys)) (act-n-lines n-col-lines) ; n-col-lines in first column @@ -703,6 +704,7 @@ keys to be written into the upper left porition of the page." (iter-n 0) col-keys col-key-width col-desc-width col-width col-split done n-columns new-column page col-sep-width prev-rem-keys) + ;; (message "frame-width %s prefix-width %s avl-width %s max-width %s" (frame-text-cols) prefix-width avl-width max-width) (while (and (<= iter-n max-iter) (not done)) (setq iter-n (1+ iter-n) col-split (-split-at n-col-lines rem-keys) @@ -791,9 +793,7 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-lines (when (car max-dims) (car max-dims))) (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) - (avl-width (when (cdr max-dims) - (- (cdr max-dims) - prefix-width which-key-unicode-correction))) + (avl-width (when (cdr max-dims) (cdr max-dims))) (keys-rem formatted-keys) (max-pages (+ 1 (length formatted-keys))) (page-n 0) commit 8bb934e8e7fc18a5b48ab4086cde5cedde0ff6d3 Author: Justin Burkett Date: Sun Jul 12 20:04:34 2015 -0400 Fix #32 Main problem was a replacement regexp that looked for a forward slash in the description, which removed group:x/y diff --git a/which-key.el b/which-key.el index 10c4b917bbc..c31166677c6 100644 --- a/which-key.el +++ b/which-key.el @@ -65,7 +65,7 @@ in the first example." :group 'which-key :type '(alist :key-type regexp :value-type string)) (defcustom which-key-description-replacement-alist - '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1") + '(("Prefix Command" . "prefix") ("select-window-\\([1-9]\\)" . "Window \\1")) "See `which-key-key-replacement-alist'. This is a list of lists for replacing descriptions. The second @@ -609,6 +609,20 @@ corresponding `which-key-special-key-face'." (substring key-w-face end (length key-w-face)))) key-w-face)))) +(defun which-key/propertize-description (description) + (let* ((desc description) + (group-prfx (string-match-p "^group:" desc)) + (group (or group-prfx + (keymapp (intern desc)) + (string-match-p "^Prefix" desc))) + (desc (if group-prfx (substring desc 6) desc)) + (desc (if group (concat "+" desc) desc)) + (desc (which-key/truncate-description desc))) + (propertize desc 'face + (if group + 'which-key-group-description-face + 'which-key-command-description-face)))) + (defsubst which-key/truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." (if (> (length desc) which-key-max-description-length) @@ -631,16 +645,8 @@ alists. Returns a list (key separator description)." (desc (which-key/maybe-replace desc which-key-description-replacement-alist)) (desc (which-key/maybe-replace-key-based desc keys)) - (group (string-match-p "^group:" desc)) - (desc (if group (substring desc 6) desc)) - (prefix (string-match-p "^Prefix" desc)) - (desc (if (or prefix group) (concat "+" desc) desc)) - (desc-face (if (or prefix group) - 'which-key-group-description-face - 'which-key-command-description-face)) - (desc (which-key/truncate-description desc)) (key-w-face (which-key/propertize-key key)) - (desc-w-face (propertize desc 'face desc-face)) + (desc-w-face (which-key/propertize-description desc)) (key-width (length (substring-no-properties key-w-face)))) (setq max-key-width (max key-width max-key-width)) (list key-w-face sep-w-face desc-w-face))) commit e37adcd72588b3b699091ac116c742a6bc073ca8 Author: Justin Burkett Date: Sun Jul 12 13:11:31 2015 -0400 Fix unicode-correction docstring diff --git a/which-key.el b/which-key.el index c02dc32f909..10c4b917bbc 100644 --- a/which-key.el +++ b/which-key.el @@ -44,8 +44,17 @@ Also adds \"..\"." :type 'string) (defcustom which-key-unicode-correction 1 "Correction for wide unicode characters. -Set to a positive number to adjust width of columns in case -which-key is cutting off text on the right side of the window." +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 1 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-key-replacement-alist @@ -776,8 +785,9 @@ value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-lines (when (car max-dims) (car max-dims))) (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) - (avl-width (when (cdr max-dims) (- (cdr max-dims) - prefix-width which-key-unicode-correction))) + (avl-width (when (cdr max-dims) + (- (cdr max-dims) + prefix-width which-key-unicode-correction))) (keys-rem formatted-keys) (max-pages (+ 1 (length formatted-keys))) (page-n 0) commit dc84416e90b4073b9c488e8644629848aaf37adb Author: Justin Burkett Date: Sun Jul 12 13:00:53 2015 -0400 Add support for custom display functions diff --git a/README.org b/README.org index 47c63bf82e8..d287cf0a63b 100644 --- a/README.org +++ b/README.org @@ -12,6 +12,7 @@ Rewrite of guide-key-mode for emacs. - [[#minibuffer][minibuffer]] - [[#side-window][side window]] - [[#frame][frame]] + - [[#custom][custom]] - [[#custom-string-replacement][Custom String Replacement]] - [[#key-based-replacement]["Key-Based" replacement]] - [[#key-and-description-replacement][Key and Description replacement]] @@ -88,8 +89,9 @@ Popup side window on bottom. For defaults use There are more options than the ones described here. All of the configurable variables are available through =M-x customize-group which-key=. ** Several Popup Types -There are three different popup types that which-key can use to display the -available keys. The variable =which-key-popup-type= decides which one is used. +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) @@ -115,6 +117,7 @@ Show keys in a side window. This popup type has further options: (setq which-key-side-window-max-height 0.25) #+END_SRC *** frame + #+BEGIN_SRC emacs-lisp (setq which-key-popup-type 'frame) #+END_SRC @@ -128,6 +131,36 @@ further options: ;; 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 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 diff --git a/which-key.el b/which-key.el index 506cadaeca1..c02dc32f909 100644 --- a/which-key.el +++ b/which-key.el @@ -97,11 +97,12 @@ the feature off." (const :tag "In first line" top) (const :tag "Hide" nil))) (defcustom which-key-popup-type 'minibuffer - "Supported types are minibuffer, side-window and frame." + "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 "Show in popup frame" frame) + (const :tag "Use your custom display functions" custom))) (defcustom which-key-side-window-location 'right "Location of which-key popup when `which-key-popup-type' is side-window. Should be one of top, bottom, left or right." @@ -160,6 +161,21 @@ a percentage out of the frame's height." "Face for special keys (SPC, TAB, RET)" :group 'which-key) +;; Custom popup +(defvar 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).") +(defvar 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.") +(defvar 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.") + ;; Internal Vars ;; (defvar popwin:popup-buffer nil) (defvar which-key--buffer nil @@ -351,7 +367,8 @@ total height." (cl-case which-key-popup-type (minibuffer (which-key/hide-buffer-minibuffer)) (side-window (which-key/hide-buffer-side-window)) - (frame (which-key/hide-buffer-frame)))) + (frame (which-key/hide-buffer-frame)) + (custom (funcall #'which-key/custom-hide-popup-function)))) (defun which-key/hide-buffer-minibuffer () "Does nothing. Stub for consistency with other hide-buffer @@ -379,7 +396,8 @@ need to start the closing timer." (cl-case which-key-popup-type (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))))) + (frame (which-key/show-buffer-frame act-popup-dim)) + (custom (funcall #'which-key/custom-show-popup-function act-popup-dim))))) (defun which-key/show-buffer-minibuffer (act-popup-dim) "Does nothing. Stub for consistency with other show-buffer @@ -499,7 +517,8 @@ 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)))) + (frame (which-key/frame-max-dimensions)) + (custom (funcall #'which-key/custom-popup-max-dimensions-function selected-window-width)))) (defun which-key/minibuffer-max-dimensions () "Return max-dimensions of minibuffer (height . width) in lines commit bed497a846a51c22553c81c3717554d50e20942d Author: Justin Burkett Date: Sun Jul 12 11:53:09 2015 -0400 Change default unicode-correction diff --git a/which-key.el b/which-key.el index 4350c73fbeb..506cadaeca1 100644 --- a/which-key.el +++ b/which-key.el @@ -42,7 +42,7 @@ Also adds \"..\"." "Separator to use between key and description." :group 'which-key :type 'string) -(defcustom which-key-unicode-correction 0 +(defcustom which-key-unicode-correction 1 "Correction for wide unicode characters. Set to a positive number to adjust width of columns in case which-key is cutting off text on the right side of the window." commit 08d07360a2a57f67e73d80332c3cf5c93520e612 Author: Justin Burkett Date: Sun Jul 12 11:48:15 2015 -0400 Update commentary diff --git a/which-key.el b/which-key.el index 7a4096b1cb1..4350c73fbeb 100644 --- a/which-key.el +++ b/which-key.el @@ -3,20 +3,15 @@ ;; Copyright (C) 2015 Justin Burkett ;; Author: Justin Burkett -;; URL: https://github.com/justbur/which-key/ +;; URL: https://github.com/justbur/which-key ;; Version: 0.1 ;; Keywords: ;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) ;;; Commentary: ;; -;; This is a rewrite of guide-key https://github.com/kai2nenobu/guide-key -;; with the following goals: -;; -;; 1. Remove polling function for performance reasons -;; 2. Try to simplify code as much as possible -;; 3. Switch away from using popwin (planned) -;; 4. Add replacement strings to create "aliases" for functions. +;; This is a rewrite of guide-key https://github.com/kai2nenobu/guide-key. See +;; https://github.com/justbur/which-key for more information. ;; ;;; Code: commit fa1e05e47a569aef0b8f970ca79d017ac444e84e Author: Justin Burkett Date: Sun Jul 12 11:44:44 2015 -0400 Fixes #24 (Update docstrings) diff --git a/which-key.el b/which-key.el index 8faddbcb674..7a4096b1cb1 100644 --- a/which-key.el +++ b/which-key.el @@ -32,15 +32,15 @@ :type 'float) (defcustom which-key-echo-keystrokes (min echo-keystrokes (/ (float which-key-idle-delay) 4)) - "Value to use for echo-keystrokes. This only applies when -`which-key-popup-type' is minibuffer. It needs to be less than -`which-key-idle-delay' or else the echo will erase the which-key -popup." + "Value to use for `echo-keystrokes'. +This only applies when `which-key-popup-type' is minibuffer. It +needs to be less than `which-key-idle-delay' or else the 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 -\"..\"." + "Truncate the description of keys to this length. +Also adds \"..\"." :group 'which-key :type 'integer) (defcustom which-key-separator "→" @@ -48,33 +48,33 @@ popup." :group 'which-key :type 'string) (defcustom which-key-unicode-correction 0 - "Correction for wide unicode characters. Set to a positive -number to adjust width of columns in case which-key is cutting -off text on the right side of the window." + "Correction for wide unicode characters. +Set to a positive number to adjust width of columns in case +which-key is cutting off text on the right side of the window." :group 'which-key :type 'integer) (defcustom which-key-key-replacement-alist '(("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") ("left" . "←") ("right" . "→")) "The strings in the car of each cons are replaced with the -strings in the cdr for each key. Elisp regexp can be used as +strings in the cdr for each key. Elisp regexp can be used as in the first example." :group 'which-key :type '(alist :key-type regexp :value-type string)) (defcustom which-key-description-replacement-alist '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1") ("select-window-\\([1-9]\\)" . "Window \\1")) - "See `which-key-key-replacement-alist'. This is a list of lists -for replacing descriptions. The second one removes \"namespace/\" -from \"namespace/function\". This is a convention for naming -functions but not a rule, so remove this replacement if it -becomes problematic." + "See `which-key-key-replacement-alist'. +This is a list of lists for replacing descriptions. The second +one removes \"namespace/\" from \"namespace/function\". This is a +convention for naming functions but not a rule, so remove this +replacement if it becomes problematic." :group 'which-key :type '(alist :key-type regexp :value-type string)) (defcustom which-key-key-based-description-replacement-alist '() - "Each item in the list is a cons cell. The car of each cons -cell is either a string like \"C-c\", in which case it's -interpreted as a key sequence or a value of `major-mode'. Here -are two examples: + "Each item in the list is a cons cell. +The car of each cons cell is either a string like \"C-c\", in +which case it's interpreted as a key sequence or a value of +`major-mode'. Here are two examples: (\"SPC f f\" . \"find files\") (emacs-lisp-mode . ((\"SPC m d\" . \"debug\"))) @@ -95,7 +95,7 @@ and have `which-key-special-key-face' applied to them." :type 'string) (defcustom which-key-show-prefix 'left "Whether to and where to display the current prefix sequence. -Possible choices are left (the default), top and nil. Nil turns +Possible choices are left (the default), top and nil. Nil turns the feature off." :group 'which-key :type '(radio (const :tag "Left of keys" left) @@ -137,9 +137,8 @@ a percentage out of the frame's height." "Maximum height of which-key popup when type is frame." :group 'which-key :type 'integer) -(defcustom which-key-show-page-number t - "Show page number and remaining keys in last slot, when keys -are hidden?" +(defcustom which-key-show-remaining-keys t + "Show remaining keys in last slot, when keys are hidden." :group 'which-key :type '(radio (const :tag "Yes" t) (const :tag "No" nil))) @@ -180,7 +179,7 @@ are hidden?" "Internal: Holds reference to which-key frame. Used when `which-key-popup-type' is frame.") (defvar which-key--echo-keystrokes-backup echo-keystrokes - "Internal: Backup the initial value of echo-keystrokes.") + "Internal: Backup the initial value of `echo-keystrokes'.") ;;;###autoload (define-minor-mode which-key-mode @@ -353,21 +352,26 @@ total height." ;; Show/hide guide buffer (defun which-key/hide-popup () + "This function is called to hide the which-key buffer." (cl-case which-key-popup-type (minibuffer (which-key/hide-buffer-minibuffer)) (side-window (which-key/hide-buffer-side-window)) (frame (which-key/hide-buffer-frame)))) (defun which-key/hide-buffer-minibuffer () + "Does nothing. Stub for consistency with other hide-buffer +functions." nil) (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))) @@ -383,15 +387,19 @@ need to start the closing timer." (frame (which-key/show-buffer-frame act-popup-dim))))) (defun which-key/show-buffer-minibuffer (act-popup-dim) + "Does nothing. Stub for consistency with other show-buffer +functions." nil) -;; &rest params because `fit-buffer-to-window' has a different call signature -;; in different emacs versions (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* ((side which-key-side-window-location) (alist '((window-width . which-key/fit-buffer-to-window-horizontally) (window-height . fit-window-to-buffer)))) @@ -415,6 +423,7 @@ need to start the closing timer." (display-buffer-in-major-side-window which-key--buffer side 0 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 @@ -437,6 +446,7 @@ need to start the closing timer." 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 @@ -460,6 +470,7 @@ need to start the closing timer." 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))))) @@ -486,14 +497,18 @@ need to start the closing timer." ;; Max dimension of available window functions (defun which-key/popup-max-dimensions (selected-window-width) - "Dimesion functions should return the maximum possible (height . width) -of the intended popup." + "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)))) (defun which-key/minibuffer-max-dimensions () + "Return max-dimensions of minibuffer (height . width) in lines +and characters respectively." (cons ;; height (if (floatp max-mini-window-height) @@ -504,6 +519,8 @@ of the intended popup." (frame-text-cols))) (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)) @@ -518,6 +535,8 @@ of the intended popup." (frame-width)))) (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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -527,7 +546,8 @@ of the intended popup." "Perform replacements on STRING. REPL-ALIST is an alist where the car of each element is the text to replace and the cdr is the replacement text. Unless LITERAL is -non-nil regexp is used in the replacements." +non-nil regexp is used in the replacements. Whether or not a +replacement occurs return the new STRING." (save-match-data (let ((new-string string)) (dolist (repl repl-alist) @@ -537,6 +557,10 @@ non-nil regexp is used in the replacements." new-string))) (defun which-key/maybe-replace-key-based (string keys) + "KEYS is a key sequence like \"C-c C-c\" and STRING is the +description that is possibly replaced using the +`which-key-key-based-description-replacement-alist'. Whether or +not a replacement occurs return the new STRING." (let* ((alist which-key-key-based-description-replacement-alist) (str-res (assoc-string keys alist)) (mode-alist (assq major-mode alist)) @@ -546,6 +570,9 @@ non-nil regexp is used in the replacements." (t string)))) (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 @@ -566,13 +593,11 @@ non-nil regexp is used in the replacements." desc)) (defun which-key/format-and-replace (unformatted prefix-keys) - "Turn each key-desc-cons in UNFORMATTED into formatted -strings (including text properties), and pad with spaces so that -all are a uniform length. Replacements are performed using the -key and description replacement alists." + "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 ((max-key-width 0) - (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face))) ;(max-desc-width 0) - ;; first replace and apply faces + (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face))) (mapcar (lambda (key-desc-cons) (let* ((key (car key-desc-cons)) @@ -594,19 +619,18 @@ key and description replacement alists." (key-w-face (which-key/propertize-key key)) (desc-w-face (propertize desc 'face desc-face)) (key-width (length (substring-no-properties key-w-face)))) - ;; (desc-width (length (substring-no-properties desc-w-face)))) (setq max-key-width (max key-width max-key-width)) - ;; (setq max-desc-width (max desc-width max-desc-width)) (list key-w-face sep-w-face desc-w-face))) unformatted))) -;; pad to max key-width and max desc-width -(defun which-key/get-formatted-key-bindings (buffer key) - (let ((key-str-qt (regexp-quote (key-description key))) +(defun which-key/get-formatted-key-bindings (buffer key-seq) + "Uses `describe-buffer-bindings' to collect the key bindings in +BUFFER that follow the key sequence KEY-SEQ." + (let ((key-str-qt (regexp-quote (key-description key-seq))) key-match desc-match unformatted format-res formatted column-width) (with-temp-buffer - (describe-buffer-bindings buffer key) + (describe-buffer-bindings buffer key-seq) (goto-char (point-max)) ; want to put last keys in first (while (re-search-backward (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" @@ -616,12 +640,14 @@ key and description replacement alists." desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted :test (lambda (x y) (string-equal (car x) (car y)))))) - (which-key/format-and-replace unformatted (key-description key)))) + (which-key/format-and-replace unformatted (key-description key-seq)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for laying out which-key buffer pages (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 (if (eq (car y) 'status) 0 (length (substring-no-properties (nth index y)))))) @@ -629,8 +655,10 @@ key and description replacement alists." (defun which-key/create-page-vertical (keys max-lines max-width prefix-width) "Format KEYS into string representing a single page of text. -N-COLUMNS is the number of text columns to use and MAX-LINES is -the maximum number of lines availabel in the target buffer." +Creates columns (padded to be of uniform width) of length +MAX-LINES until keys run out or MAX-WIDTH is reached. A non-zero +PREFIX-WIDTH adds padding on the left side to allow for prefix +keys to be written into the upper left porition of the page." (let* ((n-keys (length keys)) (avl-lines max-lines) (avl-width (- (+ 1 max-width) prefix-width)); we get 1 back for not putting a space after the last column @@ -670,7 +698,7 @@ the maximum number of lines availabel in the target buffer." (if (<= col-width avl-width) (setq all-columns (push new-column all-columns) act-width (+ act-width col-width) - avl-width (- avl-width col-width)) + avl-width (- avl-width col-width)) (setq done t rem-keys prev-rem-keys)) (when (<= (length rem-keys) 0) (setq done t))) @@ -683,7 +711,13 @@ the maximum number of lines availabel in the target buffer." (when (not (= i (- act-n-lines 1))) "\n")))))) (list page act-n-lines act-width rem-keys (- n-keys (length rem-keys))))) -(defun which-key/create-page (keys max-lines max-width prefix-width vertical use-status-key page-n) +(defun which-key/create-page (keys max-lines max-width prefix-width &optional vertical use-status-key page-n) + "Create a page of KEYS with parameters MAX-LINES, MAX-WIDTH,PREFIX-WIDTH. +Use as many keys as possible. Use as few lines as possible unless +VERTICAL is non-nil. USE-STATUS-KEY inserts an informative +message in place of the last key on the page if non-nil. PAGE-N +allows for the informative message to reference the current page +number." (let* ((n-keys (length keys)) (first-try (which-key/create-page-vertical keys max-lines max-width prefix-width)) (n-rem-keys (length (nth 3 first-try))) @@ -713,7 +747,10 @@ the maximum number of lines availabel in the target buffer." prev-try)))) (defun which-key/populate-buffer (prefix-keys formatted-keys sel-win-width) - "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." + "Insert FORMATTED-KEYS into which-key buffer. +PREFIX-KEYS may be inserted into the buffer depending on the +value of `which-key-show-prefix'. SEL-WIN-WIDTH is passed to +`which-key/popup-max-dimensions'." (let* ((vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) (prefix-w-face (which-key/propertize-key prefix-keys)) @@ -736,7 +773,7 @@ the maximum number of lines availabel in the target buffer." (setq page-n (1+ page-n) page-res (which-key/create-page keys-rem max-lines avl-width prefix-width - vertical which-key-show-page-number page-n) + vertical which-key-show-remaining-keys page-n) pages (push page-res pages) keys-per-page (push (if (nth 4 page-res) (nth 4 page-res) 0) keys-per-page) keys-rem (nth 3 page-res) @@ -751,7 +788,7 @@ the maximum number of lines availabel in the target buffer." (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." prefix-keys) (cons 0 0)) (max-pages-reached - (error "error: which-key reached the maximum number of pages") + (error "Which-key reached the maximum number of pages") (cons 0 0)) ((<= (length formatted-keys) 0) (message "%s- which-key: no keys to display" prefix-keys) @@ -769,7 +806,7 @@ the maximum number of lines availabel in the target buffer." ;; Update (defun which-key/update () - "Fill which-key--buffer with key descriptions and reformat. + "Fill `which-key--buffer' with key descriptions and reformat. Finally, show the buffer." (let ((prefix-keys (this-single-command-keys))) ;; (when (> (length prefix-keys) 0) @@ -792,13 +829,13 @@ Finally, show the buffer." ;; Timers (defun which-key/start-open-timer () - "Activate idle timer." + "Activate idle timer to trigger `which-key/update'." (which-key/stop-open-timer) ; start over (setq which-key--open-timer (run-with-idle-timer which-key-idle-delay t 'which-key/update))) (defun which-key/stop-open-timer () - "Deactivate idle timer." + "Deactivate idle timer for `which-key/update'." (when which-key--open-timer (cancel-timer which-key--open-timer))) (provide 'which-key) commit 7fb4ddc92e9cb3afb051ad53af28be3c745b483b Author: Justin Burkett Date: Sun Jul 12 11:02:47 2015 -0400 Cleanup replacement helper functions diff --git a/which-key.el b/which-key.el index 897af2b890d..8faddbcb674 100644 --- a/which-key.el +++ b/which-key.el @@ -249,16 +249,20 @@ bottom." ;; Helper functions to modify replacement lists. (defun which-key//add-key-based-replacements (alist key repl) + "Internal function to add (KEY . REPL) to ALIST." (when (or (not (stringp key)) (not (stringp repl))) (error "KEY and REPL should be strings")) - (cl-pushnew (cons key repl) alist - :test (lambda (x y) - (let ((cx (car x)) (cy (car y))) - (or (and (stringp cx) (stringp cy) (string-equal cx cy)) - (and (symbolp cx) (symbolp cy) (eq cx cy)))))) + (when (assoc-string key alist) + (message "which-key note: The key %s already exists in %s. This addition will override that replacement.")) + (setq alist (push (cons key repl) alist)) alist) (defun which-key/add-key-based-replacements (key repl &rest more) + "Replace the description of a key sequence KEY (e.g., \"C-c +C-c\") with REPL. Both KEY and REPL should be strings. MORE +allows you to specifcy additional KEY REPL pairs. All +replacements are added to +`which-key-key-based-description-replacement-alist'." ;; TODO: Make interactive (while key (setq which-key-key-based-description-replacement-alist @@ -267,6 +271,9 @@ bottom." (setq key (pop more) repl (pop more)))) (defun which-key/add-major-mode-key-based-replacements (mode key repl &rest more) + "Functions like `which-key/add-key-based-replacements' with the +exception that KEY and REPL (MORE contains addition KEY REPL +pairs) will only apply when the major-mode MODE is active." ;; TODO: Make interactive (when (not (symbolp mode)) (error "MODE should be a symbol corresponding to a value of major-mode")) commit 6ce1420de93be52683ea24c9fdd5d391c10622d9 Author: Justin Burkett Date: Sat Jul 11 16:24:00 2015 -0400 Add note to README about side-window defaults diff --git a/README.org b/README.org index 721ef167b01..47c63bf82e8 100644 --- a/README.org +++ b/README.org @@ -68,6 +68,11 @@ Popup side window on right. For defaults use (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 Bottom Option commit cadb9e7304070f240a77923aaa37288b776d2ec4 Author: Justin Burkett Date: Sat Jul 11 16:12:53 2015 -0400 Add unicode correction for wide unicode chars diff --git a/which-key.el b/which-key.el index 5be226f62e3..897af2b890d 100644 --- a/which-key.el +++ b/which-key.el @@ -47,6 +47,12 @@ popup." "Separator to use between key and description." :group 'which-key :type 'string) +(defcustom which-key-unicode-correction 0 + "Correction for wide unicode characters. Set to a positive +number to adjust width of columns in case which-key is cutting +off text on the right side of the window." + :group 'which-key + :type 'integer) (defcustom which-key-key-replacement-alist '(("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") ("left" . "←") ("right" . "→")) "The strings in the car of each cons are replaced with the @@ -712,7 +718,8 @@ the maximum number of lines availabel in the target buffer." (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-lines (when (car max-dims) (car max-dims))) (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) - (avl-width (when (cdr max-dims) (- (cdr max-dims) prefix-width))) + (avl-width (when (cdr max-dims) (- (cdr max-dims) + prefix-width which-key-unicode-correction))) (keys-rem formatted-keys) (max-pages (+ 1 (length formatted-keys))) (page-n 0) commit 1fa254f62f780c2c08a1888303855f4f5fbffe01 Author: Justin Burkett Date: Sat Jul 11 13:38:56 2015 -0400 Add default replacement for select-window-[N] diff --git a/which-key.el b/which-key.el index 20594797c8a..5be226f62e3 100644 --- a/which-key.el +++ b/which-key.el @@ -55,7 +55,8 @@ in the first example." :group 'which-key :type '(alist :key-type regexp :value-type string)) (defcustom which-key-description-replacement-alist - '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1")) + '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1") + ("select-window-\\([1-9]\\)" . "Window \\1")) "See `which-key-key-replacement-alist'. This is a list of lists for replacing descriptions. The second one removes \"namespace/\" from \"namespace/function\". This is a convention for naming commit fab4fd5fcf62d67de7f26ba2d37c94aaa8cf4397 Author: Justin Burkett Date: Sat Jul 11 13:38:39 2015 -0400 Mention customize-group in README diff --git a/README.org b/README.org index 0eefa0554af..721ef167b01 100644 --- a/README.org +++ b/README.org @@ -80,6 +80,8 @@ Popup side window on bottom. For defaults use [[./img/which-key-bottom.png]] * 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=. ** Several Popup Types There are three different popup types that which-key can use to display the available keys. The variable =which-key-popup-type= decides which one is used. commit e09eb1b024d8ade100e1b2279690a6d2cbfb9563 Author: Justin Burkett Date: Sat Jul 11 13:28:58 2015 -0400 Readme typo diff --git a/README.org b/README.org index 6744fb44a8d..0eefa0554af 100644 --- a/README.org +++ b/README.org @@ -142,7 +142,7 @@ 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 -(org-mode . '(("C-c C-c" . "Org C-c C-c") ("C-c C-a" . "Org Attach")) +(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 and the second is a list of the first commit f5385afa088b2564ebe9fcca36e3614a5a3b3a04 Merge: 3e64a54d1b5 267b707480e Author: Justin Burkett Date: Sat Jul 11 13:27:45 2015 -0400 Merge branch 'master' of https://github.com/justbur/emacs-which-key commit 3e64a54d1b5080a9d2d03aa813077131135770c0 Author: Justin Burkett Date: Sat Jul 11 13:25:49 2015 -0400 Add replacement descriptions to readme. Also move status list to end diff --git a/README.org b/README.org index 96a66b35793..6744fb44a8d 100644 --- a/README.org +++ b/README.org @@ -7,17 +7,19 @@ Rewrite of guide-key-mode for emacs. - [[#minibuffer-option][Minibuffer Option]] - [[#side-window-right-option][Side Window Right Option]] - [[#side-window-bottom-option][Side Window Bottom Option]] - - [[#statusgoals][Status/Goals]] - - [[#stability][Stability]] - - [[#completed-goals][Completed Goals]] - - [[#incomplete-and-planned][Incomplete and Planned]] - - [[#special-features][Special Features]] + - [[#special-features-and-configuration-options][Special Features and Configuration Options]] - [[#several-popup-types][Several Popup Types]] - [[#minibuffer][minibuffer]] - [[#side-window][side window]] - [[#frame][frame]] - [[#custom-string-replacement][Custom String Replacement]] + - [[#key-based-replacement]["Key-Based" replacement]] + - [[#key-and-description-replacement][Key and Description replacement]] - [[#nice-display-with-split-frame][Nice Display with Split Frame]] + - [[#statusgoals][Status/Goals]] + - [[#stability][Stability]] + - [[#completed-goals][Completed Goals]] + - [[#incomplete-and-planned][Incomplete and Planned]] * Install Add which-key.el to your =load-path= and require. Something like @@ -77,26 +79,7 @@ Popup side window on bottom. For defaults use [[./img/which-key-bottom.png]] -* Status/Goals -** Stability -- It's very much a work in progress, so expect weird things to happen from time - to time. That being said, the default configuration works well for me. -** Completed Goals -1. Use idle timers to trigger window popup instead of guide-key's constant - polling. -2. Remove popwin as a "hard" dependency, prefering built-in display commands - where possible. -3. Add support for replacement lists to modify key descriptions on the fly. - Currently you can replace in the key or description field using regexp, and - using a key sequence (like =C-x 1=) to fully replace the description (the - latter can target major modes, too). -** Incomplete and Planned -1. Come up with creative ways to fit more keys in buffer while still maintaining - nice alignment and formatting. Such as - 1. Automatic text scaling - 2. Paging functionality - -* Special Features +* Special Features and Configuration Options ** Several Popup Types There are three different popup types that which-key can use to display the available keys. The variable =which-key-popup-type= decides which one is used. @@ -139,7 +122,63 @@ further options: (setq which-key-frame-max-height 20) #+END_SRC ** Custom String Replacement -TODO... +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 +The relevant variable is the awkwardly named +=which-key-key-based-description-replacement-alist=. In this alist you can have +cons cells of two types. An example of the first type is + +#+BEGIN_SRC emacs-lisp +("C-x C-f" . "find files") +#+END_SRC + +where the string on the left is the key combination whose description you want +to replace. 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 +(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 and the second is 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 will take precedence. + +There are two helper functions to add entries to this list, +=which-key/add-key-based-replacements= and +=which-key/add-major-mode-key-based-replacements=. You can modify the alist +directly or use these. + +*** Key and Description replacement +The second and third methods target the text used for the keys and the +descriptions directly. The relevant variables are +=which-key-key-replacement-alist= and =which-key-description-replacement-alist=. +Here's an example of one of the default key replacements + +#+BEGIN_SRC emacs-lisp +("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") +#+END_SRC + +The =car= takes a string which may use emacs regexp and the =cdr= takes a string +with the replacement text. As shown, you can specify a sub-expression of the +match. The replacements do not need to use regexp and can be as simple as + +#+BEGIN_SRC emacs-lisp +("left" . "lft") +#+END_SRC + +You can add this element to the key list with (there are no helper functions for +these alists) + +#+BEGIN_SRC emacs-lisp +(add-to-list 'which-key-key-replacement-alist '("left" . "lft")) +#+END_SRC + ** Nice Display with Split Frame Unlike guide-key, which-key looks good even if the frame is split into several windows. @@ -148,3 +187,22 @@ windows. #+CAPTION: which-key in a frame with 2 vertical splits [[./img/which-key-bottom-split.png]] + +* Status/Goals +** Stability +It's very much a work in progress, so expect weird things to happen from time to +time. That being said, the default configuration works well for me. +** Completed Goals +1. Use idle timers to trigger window popup instead of guide-key's constant + polling. +2. Remove popwin as a "hard" dependency, preferring built-in display commands + where possible. +3. Add support for replacement lists to modify key descriptions on the fly. + Currently you can replace in the key or description field using regexp, and + using a key sequence (like =C-x 1=) to fully replace the description (the + latter can target major modes, too). +** Incomplete and Planned +1. Come up with creative ways to fit more keys in buffer while still maintaining + nice alignment and formatting. Such as + 1. Automatic text scaling + 2. Paging functionality commit 267b707480e06fff944045421367a90863c9f31b Merge: 7e6e379dbf9 d0a5ac43a5e Author: Justin Burkett Date: Sat Jul 11 12:58:03 2015 -0400 Merge pull request #30 from bmag/readme Start special-features section in readme #29 commit e947317faa1d207cc9b21f1843a73f07b4d19a06 Merge: 7e6e379dbf9 d0a5ac43a5e Author: Justin Burkett Date: Sat Jul 11 12:55:23 2015 -0400 Merge branch 'readme' of https://github.com/bmag/emacs-which-key into readme commit 7e6e379dbf961f3b398bde5b64f837d595da8358 Author: Justin Burkett Date: Sat Jul 11 12:52:35 2015 -0400 Show prefix in can't show messages diff --git a/which-key.el b/which-key.el index b71498c3b04..20594797c8a 100644 --- a/which-key.el +++ b/which-key.el @@ -733,13 +733,13 @@ the maximum number of lines availabel in the target buffer." first-page (car pages) first-page-str (concat prefix-string (car first-page))) (cond (no-room - (message "which-key can't show keys: The settings and/or frame size are too restrictive.") + (message "%s- which-key can't show keys: Settings and/or frame size are too restrictive." prefix-keys) (cons 0 0)) (max-pages-reached (error "error: which-key reached the maximum number of pages") (cons 0 0)) ((<= (length formatted-keys) 0) - (message "which-key: no keys to display") + (message "%s- which-key: no keys to display" prefix-keys) (cons 0 0)) (t (if (eq which-key-popup-type 'minibuffer) commit 1f788fa86384c6c874076a6df03a3d2230d509e6 Merge: 5590a80eaff 3c4f30dfd4d Author: Justin Burkett Date: Sat Jul 11 12:49:05 2015 -0400 Merge status-key commit 3c4f30dfd4d9a61ec4269a852ded65c652c63430 Author: Justin Burkett Date: Sat Jul 11 12:42:06 2015 -0400 Add status defcustom and clean-up layout funcs diff --git a/which-key.el b/which-key.el index 80789f65224..9b150aca206 100644 --- a/which-key.el +++ b/which-key.el @@ -130,6 +130,12 @@ a percentage out of the frame's height." "Maximum height of which-key popup when type is frame." :group 'which-key :type 'integer) +(defcustom which-key-show-page-number t + "Show page number and remaining keys in last slot, when keys +are hidden?" + :group 'which-key + :type '(radio (const :tag "Yes" t) + (const :tag "No" nil))) ;; Faces (defface which-key-key-face @@ -632,7 +638,7 @@ the maximum number of lines availabel in the target buffer." col-keys (car col-split) prev-rem-keys rem-keys rem-keys (cadr col-split) - n-col-lines (min avl-lines (length col-keys)) + n-col-lines (min avl-lines (length rem-keys)) col-key-width (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) @@ -670,17 +676,18 @@ the maximum number of lines availabel in the target buffer." (status-key-i (- n-keys n-rem-keys 1)) (next-try-lines max-lines) (iter-n 0) - (max-iter max-lines) + (max-iter (+ 1 max-lines)) prev-try prev-n-rem-keys next-try found status-key) (cond ((and (> n-rem-keys 0) use-status-key) (setq status-key (cons 'status (propertize - (format "Page %s (%s not shown)" page-n (1+ n-rem-keys)) + (format "%s keys not shown" (1+ n-rem-keys)) 'face 'font-lock-comment-face))) (which-key/create-page-vertical (-insert-at status-key-i status-key keys) max-lines max-width prefix-width)) - ((or vertical (> n-rem-keys 0) (= 1 max-lines)) first-try) - ;; do a simple search for now (TODO: Implement binary search) + ((or vertical (> n-rem-keys 0) (= 1 max-lines)) + first-try) + ;; do a simple search for the smallest number of lines (TODO: Implement binary search) (t (while (and (<= iter-n max-iter) (not found)) (setq iter-n (1+ iter-n) prev-try next-try @@ -695,7 +702,6 @@ the maximum number of lines availabel in the target buffer." "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." (let* ((vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) - (use-status-key t) (prefix-w-face (which-key/propertize-key prefix-keys)) (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) (prefix-string (when which-key-show-prefix @@ -715,11 +721,11 @@ the maximum number of lines availabel in the target buffer." (setq page-n (1+ page-n) page-res (which-key/create-page keys-rem max-lines avl-width prefix-width - vertical use-status-key page-n) + vertical which-key-show-page-number page-n) pages (push page-res pages) keys-per-page (push (if (nth 4 page-res) (nth 4 page-res) 0) keys-per-page) keys-rem (nth 3 page-res) - no-room (and (= page-n 1) (= (car keys-per-page) 0)) + no-room (<= (car keys-per-page) 0) max-pages-reached (>= page-n max-pages))) ;; not doing anything with other pages for now (setq keys-per-page (reverse keys-per-page) @@ -730,10 +736,10 @@ the maximum number of lines availabel in the target buffer." (message "which-key can't show keys: The settings and/or frame size are too restrictive.") (cons 0 0)) (max-pages-reached - (error "which-key reached the maximum number of pages") + (error "error: which-key reached the maximum number of pages") (cons 0 0)) ((<= (length formatted-keys) 0) - (message "No keys to display") + (error "error: which-key: no keys to display") (cons 0 0)) (t (if (eq which-key-popup-type 'minibuffer) commit d0a5ac43a5ee7787709ccf346520c747f5ae5a82 Author: Bar Magal Date: Sat Jul 11 19:25:43 2015 +0300 readme: explain different popup types diff --git a/README.org b/README.org index b472cb540fb..96a66b35793 100644 --- a/README.org +++ b/README.org @@ -13,6 +13,9 @@ Rewrite of guide-key-mode for emacs. - [[#incomplete-and-planned][Incomplete and Planned]] - [[#special-features][Special Features]] - [[#several-popup-types][Several Popup Types]] + - [[#minibuffer][minibuffer]] + - [[#side-window][side window]] + - [[#frame][frame]] - [[#custom-string-replacement][Custom String Replacement]] - [[#nice-display-with-split-frame][Nice Display with Split Frame]] @@ -95,7 +98,46 @@ Popup side window on bottom. For defaults use * Special Features ** Several Popup Types -TODO... +There are three different popup types that which-key can use 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 +(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 String Replacement TODO... ** Nice Display with Split Frame commit 58a11404554d51592439bee50f1effe1ae0f8376 Author: Bar Magal Date: Sat Jul 11 18:47:54 2015 +0300 Start special-features section in readme #29 diff --git a/README.org b/README.org index e523a33327d..b472cb540fb 100644 --- a/README.org +++ b/README.org @@ -1,5 +1,21 @@ +* which-key Rewrite of guide-key-mode for emacs. +* Table of Contents :TOC@4: + - [[#which-key][which-key]] + - [[#install][Install]] + - [[#minibuffer-option][Minibuffer Option]] + - [[#side-window-right-option][Side Window Right Option]] + - [[#side-window-bottom-option][Side Window Bottom Option]] + - [[#statusgoals][Status/Goals]] + - [[#stability][Stability]] + - [[#completed-goals][Completed Goals]] + - [[#incomplete-and-planned][Incomplete and Planned]] + - [[#special-features][Special Features]] + - [[#several-popup-types][Several Popup Types]] + - [[#custom-string-replacement][Custom String Replacement]] + - [[#nice-display-with-split-frame][Nice Display with Split Frame]] + * Install Add which-key.el to your =load-path= and require. Something like @@ -49,7 +65,6 @@ Popup side window on right. For defaults use [[./img/which-key-right.png]] - ** Side Window Bottom Option Popup side window on bottom. For defaults use @@ -59,7 +74,6 @@ Popup side window on bottom. For defaults use [[./img/which-key-bottom.png]] - * Status/Goals ** Stability - It's very much a work in progress, so expect weird things to happen from time @@ -71,11 +85,24 @@ Popup side window on bottom. For defaults use where possible. 3. Add support for replacement lists to modify key descriptions on the fly. Currently you can replace in the key or description field using regexp, and - using a key sequence (like ="C-x 1"=) to fully replace the description (the + using a key sequence (like =C-x 1=) to fully replace the description (the latter can target major modes, too). ** Incomplete and Planned 1. Come up with creative ways to fit more keys in buffer while still maintaining nice alignment and formatting. Such as 1. Automatic text scaling - 2. Paging functionality - + 2. Paging functionality + +* Special Features +** Several Popup Types +TODO... +** Custom String Replacement +TODO... +** 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]] diff --git a/img/which-key-bottom-split.png b/img/which-key-bottom-split.png new file mode 100644 index 00000000000..b1d1de9f2c7 Binary files /dev/null and b/img/which-key-bottom-split.png differ diff --git a/img/which-key-right-split.png b/img/which-key-right-split.png new file mode 100644 index 00000000000..944293fd939 Binary files /dev/null and b/img/which-key-right-split.png differ commit 22d957e8f6ff4f8e1f97b8bdf4f0e3de09b84c98 Author: Justin Burkett Date: Sat Jul 11 06:53:46 2015 -0400 Add better check for no room in frame diff --git a/which-key.el b/which-key.el index 96c4537ecb9..80789f65224 100644 --- a/which-key.el +++ b/which-key.el @@ -620,7 +620,7 @@ the maximum number of lines availabel in the target buffer." (all-columns (list (mapcar (lambda (i) (if (> i 1) (s-repeat prefix-width " ") "")) - (number-sequence 1 n-col-lines)))) + (number-sequence 1 n-col-lines)))) (act-width prefix-width) (max-iter 100) (iter-n 0) @@ -709,32 +709,40 @@ the maximum number of lines availabel in the target buffer." (keys-rem formatted-keys) (max-pages (+ 1 (length keys-rem))) (page-n 0) - keys-per-page pages first-page first-page-str page-res) - (while (and (<= page-n max-pages) keys-rem) + keys-per-page pages first-page first-page-str page-res no-room + max-pages-reached) + (while (and keys-rem (not max-pages-reached) (not no-room)) (setq page-n (1+ page-n) page-res (which-key/create-page keys-rem max-lines avl-width prefix-width vertical use-status-key page-n) pages (push page-res pages) keys-per-page (push (if (nth 4 page-res) (nth 4 page-res) 0) keys-per-page) - keys-rem (nth 3 page-res))) + keys-rem (nth 3 page-res) + no-room (and (= page-n 1) (= (car keys-per-page) 0)) + max-pages-reached (>= page-n max-pages))) ;; not doing anything with other pages for now (setq keys-per-page (reverse keys-per-page) pages (reverse pages) first-page (car pages) first-page-str (concat prefix-string (car first-page))) - (if (or (= (length formatted-keys) 0) (<= (car keys-per-page) 0)) - (progn - (message "which-key can't show keys: The settings and/or frame size are too restrictive.") - (cons 0 0)) - ;; (when (> (length pages) 1) (setq first-page (concat first-page "..."))) - (if (eq which-key-popup-type 'minibuffer) - (let (message-log-max) (message "%s" first-page-str)) - (with-current-buffer which-key--buffer - (erase-buffer) - (insert first-page-str) - (goto-char (point-min)))) - (cons (nth 1 first-page) (nth 2 first-page))))) + (cond (no-room + (message "which-key can't show keys: The settings and/or frame size are too restrictive.") + (cons 0 0)) + (max-pages-reached + (error "which-key reached the maximum number of pages") + (cons 0 0)) + ((<= (length formatted-keys) 0) + (message "No keys to display") + (cons 0 0)) + (t + (if (eq which-key-popup-type 'minibuffer) + (let (message-log-max) (message "%s" first-page-str)) + (with-current-buffer which-key--buffer + (erase-buffer) + (insert first-page-str) + (goto-char (point-min)))) + (cons (nth 1 first-page) (nth 2 first-page)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update commit db8d4da7adff2ded8a7e1aa78edee8ac21590000 Author: Justin Burkett Date: Sat Jul 11 06:22:36 2015 -0400 Protect against infinite loops diff --git a/which-key.el b/which-key.el index 35143d567ff..96c4537ecb9 100644 --- a/which-key.el +++ b/which-key.el @@ -622,10 +622,13 @@ the maximum number of lines availabel in the target buffer." (if (> i 1) (s-repeat prefix-width " ") "")) (number-sequence 1 n-col-lines)))) (act-width prefix-width) + (max-iter 100) + (iter-n 0) col-keys col-key-width col-desc-width col-width col-split done n-columns new-column page col-sep-width prev-rem-keys) - (while (not done) - (setq col-split (-split-at n-col-lines rem-keys) + (while (and (<= iter-n max-iter) (not done)) + (setq iter-n (1+ iter-n) + col-split (-split-at n-col-lines rem-keys) col-keys (car col-split) prev-rem-keys rem-keys rem-keys (cadr col-split) @@ -666,6 +669,8 @@ the maximum number of lines availabel in the target buffer." (n-rem-keys (length (nth 3 first-try))) (status-key-i (- n-keys n-rem-keys 1)) (next-try-lines max-lines) + (iter-n 0) + (max-iter max-lines) prev-try prev-n-rem-keys next-try found status-key) (cond ((and (> n-rem-keys 0) use-status-key) (setq status-key @@ -676,8 +681,9 @@ the maximum number of lines availabel in the target buffer." max-lines max-width prefix-width)) ((or vertical (> n-rem-keys 0) (= 1 max-lines)) first-try) ;; do a simple search for now (TODO: Implement binary search) - (t (while (not found) - (setq prev-try next-try + (t (while (and (<= iter-n max-iter) (not found)) + (setq iter-n (1+ iter-n) + prev-try next-try next-try-lines (- next-try-lines 1) next-try (which-key/create-page-vertical keys next-try-lines max-width prefix-width) @@ -701,9 +707,10 @@ the maximum number of lines availabel in the target buffer." (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) (avl-width (when (cdr max-dims) (- (cdr max-dims) prefix-width))) (keys-rem formatted-keys) + (max-pages (+ 1 (length keys-rem))) (page-n 0) keys-per-page pages first-page first-page-str page-res) - (while keys-rem + (while (and (<= page-n max-pages) keys-rem) (setq page-n (1+ page-n) page-res (which-key/create-page keys-rem max-lines avl-width prefix-width commit 5590a80eaff9874033cd1e11e61b63345a13882f Author: Justin Burkett Date: Sat Jul 11 06:22:36 2015 -0400 Protect against infinite loops diff --git a/which-key.el b/which-key.el index 7ef63287544..b03140a9ba1 100644 --- a/which-key.el +++ b/which-key.el @@ -617,10 +617,13 @@ the maximum number of lines availabel in the target buffer." (act-width prefix-width) (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face)) + (max-iter 100) + (iter-n 0) col-key-cns col-key-width col-desc-width col-width col-split done n-columns new-column page) - (while (not done) - (setq col-split (-split-at n-col-lines rem-key-cns) + (while (and (<= iter-n max-iter) (not done)) + (setq iter-n (1+ iter-n) + col-split (-split-at n-col-lines rem-key-cns) col-key-cns (car col-split) rem-key-cns (cadr col-split) n-col-lines (min avl-lines (length rem-key-cns)) @@ -657,12 +660,15 @@ the maximum number of lines availabel in the target buffer." (let* ((first-try (which-key/create-page-vertical max-lines max-width prefix-width key-cns)) (n-rem-keys (length (nth 3 first-try))) (next-try-lines max-lines) + (iter-n 0) + (max-iter max-lines) prev-try prev-n-rem-keys next-try found) (if (or vertical (> n-rem-keys 0) (= max-lines 1)) first-try ;; do a simple search for now (TODO: Implement binary search) - (while (not found) - (setq prev-try next-try + (while (and (<= iter-n max-iter) (not found)) + (setq iter-n (1+ iter-n) + prev-try next-try next-try-lines (- next-try-lines 1) next-try (which-key/create-page-vertical next-try-lines max-width prefix-width key-cns) n-rem-keys (length (nth 3 next-try)) @@ -685,9 +691,12 @@ the maximum number of lines availabel in the target buffer." (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) (avl-width (when (cdr max-dims) (- (cdr max-dims) prefix-width))) (keys-rem formatted-keys) + (max-iter (+ 1 n-keys)) + (iter-n 0) keys-per-page pages first-page first-page-str page-res) - (while keys-rem - (setq page-res (which-key/create-page vertical max-height avl-width prefix-width keys-rem) + (while (and (<= iter-n max-iter) keys-rem) + (setq iter-n (1+ iter-n) + page-res (which-key/create-page vertical max-height avl-width prefix-width keys-rem) pages (push page-res pages) keys-per-page (push (if (nth 4 page-res) (nth 4 page-res) 0) keys-per-page) keys-rem (nth 3 page-res))) commit 76a0199eb36bb46c08bc40e57cf324393bbb499b Author: Justin Burkett Date: Fri Jul 10 22:00:14 2015 -0400 Start to fix lock up on small vertical window diff --git a/which-key.el b/which-key.el index d0703b6a975..35143d567ff 100644 --- a/which-key.el +++ b/which-key.el @@ -674,7 +674,7 @@ the maximum number of lines availabel in the target buffer." 'face 'font-lock-comment-face))) (which-key/create-page-vertical (-insert-at status-key-i status-key keys) max-lines max-width prefix-width)) - ((or (> n-rem-keys 0) (= 1 max-lines)) first-try) + ((or vertical (> n-rem-keys 0) (= 1 max-lines)) first-try) ;; do a simple search for now (TODO: Implement binary search) (t (while (not found) (setq prev-try next-try commit 16aa8acb834ddd8865100cc8ff5adfe592175696 Merge: 732b0c32c93 f8311cdcdb6 Author: Justin Burkett Date: Fri Jul 10 21:52:10 2015 -0400 Merge status-key and layout changes commit f8311cdcdb61df744310bd4bcbc543bbedc233a9 Author: Justin Burkett Date: Fri Jul 10 17:43:01 2015 -0400 Fix bug when frame too small diff --git a/which-key.el b/which-key.el index e262567fe70..7ef63287544 100644 --- a/which-key.el +++ b/which-key.el @@ -651,7 +651,7 @@ the maximum number of lines availabel in the target buffer." (setq page (concat page (nth i (nth j all-columns)) (if (not (= j (- n-columns 1))) " " (when (not (= i (- act-n-lines 1))) "\n")))))) - (list page act-n-lines act-width rem-key-cns))) + (list page act-n-lines act-width rem-key-cns (- (length key-cns) (length rem-key-cns))))) (defun which-key/create-page (vertical max-lines max-width prefix-width key-cns) (let* ((first-try (which-key/create-page-vertical max-lines max-width prefix-width key-cns)) @@ -685,16 +685,18 @@ the maximum number of lines availabel in the target buffer." (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) (avl-width (when (cdr max-dims) (- (cdr max-dims) prefix-width))) (keys-rem formatted-keys) - pages first-page first-page-str page-res) + keys-per-page pages first-page first-page-str page-res) (while keys-rem (setq page-res (which-key/create-page vertical max-height avl-width prefix-width keys-rem) pages (push page-res pages) + keys-per-page (push (if (nth 4 page-res) (nth 4 page-res) 0) keys-per-page) keys-rem (nth 3 page-res))) ;; not doing anything with other pages for now - (setq pages (reverse pages) + (setq keys-per-page (reverse keys-per-page) + pages (reverse pages) first-page (car pages) first-page-str (concat prefix-string (car first-page))) - (if (= 0 (length first-page-str)) + (if (or (<= n-keys 0) (<= (car keys-per-page) 0)) (progn (message "which-key can't show keys: The settings and/or frame size are too restrictive.") (cons 0 0)) commit 96e424db23920c8610e23b74196c034f9fa9a36c Author: Justin Burkett Date: Fri Jul 10 17:28:14 2015 -0400 Remove message diff --git a/which-key.el b/which-key.el index b3b525a6b4f..e262567fe70 100644 --- a/which-key.el +++ b/which-key.el @@ -619,7 +619,6 @@ the maximum number of lines availabel in the target buffer." 'face 'which-key-separator-face)) col-key-cns col-key-width col-desc-width col-width col-split done n-columns new-column page) - (message "ok") (while (not done) (setq col-split (-split-at n-col-lines rem-key-cns) col-key-cns (car col-split) commit ee43d74075fb6db4dd46ce2a2d64546b1d8026ce Merge: 7e2c91ed622 062f98489af Author: Justin Burkett Date: Fri Jul 10 17:13:42 2015 -0400 Merge branch 'fill-columns' commit 062f98489af421c2420a69d94b6ca1ef1e16121b Author: Justin Burkett Date: Fri Jul 10 17:12:27 2015 -0400 Reorganize code and clean-up comments a little diff --git a/which-key.el b/which-key.el index 1d27aa2803a..55779bfff0d 100644 --- a/which-key.el +++ b/which-key.el @@ -232,17 +232,6 @@ bottom." (setq which-key-popup-type 'minibuffer which-key-show-prefix 'left)) -;; Timers - -(defun which-key/start-open-timer () - "Activate idle timer." - (which-key/stop-open-timer) ; start over - (setq which-key--open-timer - (run-with-idle-timer which-key-idle-delay t 'which-key/update))) - -(defun which-key/stop-open-timer () - "Deactivate idle timer." - (when which-key--open-timer (cancel-timer which-key--open-timer))) ;; Helper functions to modify replacement lists. @@ -279,29 +268,8 @@ bottom." (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) -;; Update - -(defun which-key/update () - "Fill which-key--buffer with key descriptions and reformat. -Finally, show the buffer." - (let ((prefix-keys (this-single-command-keys))) - ;; (when (> (length prefix-keys) 0) (message "key: %s" (key-description prefix-keys))) - ;; (when (> (length prefix-keys) 0) (message "key binding: %s" (key-binding prefix-keys))) - (when (and (> (length prefix-keys) 0) - (keymapp (key-binding prefix-keys))) - (let* ((buf (current-buffer)) - ;; get formatted key bindings - (formatted-keys (which-key/get-formatted-key-bindings buf prefix-keys)) - ;; populate target buffer - (popup-act-dim - (which-key/populate-buffer (key-description prefix-keys) - formatted-keys (window-width)))) - ;; show buffer - (which-key/show-popup popup-act-dim))))) -;; command finished maybe close the window -;; (which-key/hide-popup)))) - -;; window-size utilities +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions for computing window sizes (defun which-key/text-width-to-total (text-width) "Convert window text-width to window total-width. @@ -361,6 +329,7 @@ total height." height-or-percentage (round (* height-or-percentage (window-total-height (frame-root-window)))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Show/hide guide buffer (defun which-key/hide-popup () @@ -493,7 +462,8 @@ need to start the closing timer." ;; (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) ;; (popwin:close-popup-window))) -;; Size functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Max dimension of available window functions (defun which-key/popup-max-dimensions (selected-window-width) "Dimesion functions should return the maximum possible (height . width) @@ -530,7 +500,85 @@ of the intended popup." (defun which-key/frame-max-dimensions () (cons which-key-frame-max-height which-key-frame-max-width)) -;; Buffer contents functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions for retrieving and formatting keys + +(defun which-key/maybe-replace (string repl-alist &optional literal) + "Perform replacements on STRING. +REPL-ALIST is an alist where the car of each element is the text +to replace and the cdr is the replacement text. Unless LITERAL is +non-nil regexp is used in the replacements." + (save-match-data + (let ((new-string string)) + (dolist (repl repl-alist) + (when (string-match (car repl) new-string) + (setq new-string + (replace-match (cdr repl) t literal new-string)))) + new-string))) + +(defun which-key/maybe-replace-key-based (string keys) + (let* ((alist which-key-key-based-description-replacement-alist) + (str-res (assoc-string keys alist)) + (mode-alist (assq major-mode alist)) + (mode-res (when mode-alist (assoc-string keys mode-alist)))) + (cond (mode-res (cdr mode-res)) + (str-res (cdr str-res)) + (t string)))) + +(defun which-key/propertize-key (key) + (let ((key-w-face (propertize key 'face 'which-key-key-face)) + (regexp (concat "\\(" + (mapconcat 'identity which-key-special-keys + "\\|") "\\)"))) + (save-match-data + (if (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 (length key-w-face)))) + key-w-face)))) + +(defsubst which-key/truncate-description (desc) + "Truncate DESC description to `which-key-max-description-length'." + (if (> (length desc) which-key-max-description-length) + (concat (substring desc 0 which-key-max-description-length) "..") + desc)) + +(defun which-key/format-and-replace (unformatted prefix-keys) + "Turn each key-desc-cons in UNFORMATTED into formatted +strings (including text properties), and pad with spaces so that +all are a uniform length. Replacements are performed using the +key and description replacement alists." + (let ((max-key-width 0)) ;(max-desc-width 0) + ;; first replace and apply faces + (mapcar + (lambda (key-desc-cons) + (let* ((key (car key-desc-cons)) + (desc (cdr key-desc-cons)) + (keys (concat prefix-keys " " key)) + (key (which-key/maybe-replace + key which-key-key-replacement-alist)) + (desc (which-key/maybe-replace + desc which-key-description-replacement-alist)) + (desc (which-key/maybe-replace-key-based desc keys)) + (group (string-match-p "^group:" desc)) + (desc (if group (substring desc 6) desc)) + (prefix (string-match-p "^Prefix" desc)) + (desc (if (or prefix group) (concat "+" desc) desc)) + (desc-face (if (or prefix group) + 'which-key-group-description-face + 'which-key-command-description-face)) + (desc (which-key/truncate-description desc)) + (key-w-face (which-key/propertize-key key)) + (desc-w-face (propertize desc 'face desc-face)) + (key-width (length (substring-no-properties key-w-face)))) + ;; (desc-width (length (substring-no-properties desc-w-face)))) + (setq max-key-width (max key-width max-key-width)) + ;; (setq max-desc-width (max desc-width max-desc-width)) + (cons key-w-face desc-w-face))) + unformatted))) +;; pad to max key-width and max desc-width (defun which-key/get-formatted-key-bindings (buffer key) (let ((key-str-qt (regexp-quote (key-description key))) @@ -549,6 +597,9 @@ of the intended popup." :test (lambda (x y) (string-equal (car x) (car y)))))) (which-key/format-and-replace unformatted (key-description key)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions for laying out which-key buffer pages + (defun which-key/create-page-vertical (max-lines max-width prefix-width key-cns) "Format KEYS into string representing a single page of text. N-COLUMNS is the number of text columns to use and MAX-LINES is @@ -559,10 +610,13 @@ the maximum number of lines availabel in the target buffer." (rem-key-cns key-cns) (n-col-lines (min avl-lines n-keys)) (act-n-lines n-col-lines) ; n-col-lines in first column - (all-columns (list (mapcar (lambda (i) (if (> i 1) (s-repeat prefix-width " ") "")) + (all-columns (list + (mapcar (lambda (i) + (if (> i 1) (s-repeat prefix-width " ") "")) (number-sequence 1 n-col-lines)))) (act-width prefix-width) - (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face)) + (sep-w-face (propertize which-key-separator + 'face 'which-key-separator-face)) col-key-cns col-key-width col-desc-width col-width col-split done n-columns new-column page) (message "ok") @@ -654,79 +708,41 @@ the maximum number of lines availabel in the target buffer." (goto-char (point-min)))) (cons (nth 1 first-page) (nth 2 first-page))))) -(defun which-key/maybe-replace-key-based (string keys) - (let* ((alist which-key-key-based-description-replacement-alist) - (str-res (assoc-string keys alist)) - (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc-string keys mode-alist)))) - (cond (mode-res (cdr mode-res)) - (str-res (cdr str-res)) - (t string)))) - -(defun which-key/maybe-replace (string repl-alist &optional literal) - "Perform replacements on STRING. -REPL-ALIST is an alist where the car of each element is the text -to replace and the cdr is the replacement text. Unless LITERAL is -non-nil regexp is used in the replacements." - (save-match-data - (let ((new-string string)) - (dolist (repl repl-alist) - (when (string-match (car repl) new-string) - (setq new-string - (replace-match (cdr repl) t literal new-string)))) - new-string))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Update -(defun which-key/propertize-key (key) - (let ((key-w-face (propertize key 'face 'which-key-key-face)) - (regexp (concat "\\(" (mapconcat 'identity which-key-special-keys "\\|") "\\)"))) - (save-match-data - (if (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 (length key-w-face)))) - key-w-face)))) +(defun which-key/update () + "Fill which-key--buffer with key descriptions and reformat. +Finally, show the buffer." + (let ((prefix-keys (this-single-command-keys))) + ;; (when (> (length prefix-keys) 0) + ;; (message "key: %s" (key-description prefix-keys))) + ;; (when (> (length prefix-keys) 0) + ;; (message "key binding: %s" (key-binding prefix-keys))) + (when (and (> (length prefix-keys) 0) + (keymapp (key-binding prefix-keys))) + (let* ((buf (current-buffer)) + ;; get formatted key bindings + (formatted-keys (which-key/get-formatted-key-bindings + buf prefix-keys)) + ;; populate target buffer + (popup-act-dim (which-key/populate-buffer + (key-description prefix-keys) + formatted-keys (window-width)))) + ;; show buffer + (which-key/show-popup popup-act-dim))))) -(defsubst which-key/truncate-description (desc) - "Truncate DESC description to `which-key-max-description-length'." - (if (> (length desc) which-key-max-description-length) - (concat (substring desc 0 which-key-max-description-length) "..") - desc)) +;; Timers -(defun which-key/format-and-replace (unformatted prefix-keys) - "Turn each key-desc-cons in UNFORMATTED into formatted -strings (including text properties), and pad with spaces so that -all are a uniform length. Replacements are performed using the -key and description replacement alists." - (let ((max-key-width 0)) ;(max-desc-width 0) - ;; first replace and apply faces - (mapcar - (lambda (key-desc-cons) - (let* ((key (car key-desc-cons)) - (desc (cdr key-desc-cons)) - (keys (concat prefix-keys " " key)) - (key (which-key/maybe-replace key which-key-key-replacement-alist)) - (desc (which-key/maybe-replace desc which-key-description-replacement-alist)) - (desc (which-key/maybe-replace-key-based desc keys)) - (group (string-match-p "^group:" desc)) - (desc (if group (substring desc 6) desc)) - (prefix (string-match-p "^Prefix" desc)) - (desc (if (or prefix group) (concat "+" desc) desc)) - (desc-face (if (or prefix group) - 'which-key-group-description-face - 'which-key-command-description-face)) - (desc (which-key/truncate-description desc)) - (key-w-face (which-key/propertize-key key)) - (desc-w-face (propertize desc 'face desc-face)) - (key-width (length (substring-no-properties key-w-face)))) - ;; (desc-width (length (substring-no-properties desc-w-face)))) - (setq max-key-width (max key-width max-key-width)) - ;; (setq max-desc-width (max desc-width max-desc-width)) - (cons key-w-face desc-w-face))) - unformatted))) -;; pad to max key-width and max desc-width +(defun which-key/start-open-timer () + "Activate idle timer." + (which-key/stop-open-timer) ; start over + (setq which-key--open-timer + (run-with-idle-timer which-key-idle-delay t 'which-key/update))) +(defun which-key/stop-open-timer () + "Deactivate idle timer." + (when which-key--open-timer (cancel-timer which-key--open-timer))) (provide 'which-key) ;;; which-key.el ends here commit 8d8e09e80972cd4001ec7efc411ecdc3b548d7b9 Author: Justin Burkett Date: Fri Jul 10 16:56:32 2015 -0400 Re-enable the prefix option diff --git a/which-key.el b/which-key.el index 01e2920f72d..1d27aa2803a 100644 --- a/which-key.el +++ b/which-key.el @@ -549,42 +549,41 @@ of the intended popup." :test (lambda (x y) (string-equal (car x) (car y)))))) (which-key/format-and-replace unformatted (key-description key)))) -(defun which-key/create-page-vertical (max-lines max-width key-cns) +(defun which-key/create-page-vertical (max-lines max-width prefix-width key-cns) "Format KEYS into string representing a single page of text. N-COLUMNS is the number of text columns to use and MAX-LINES is the maximum number of lines availabel in the target buffer." (let* ((n-keys (length key-cns)) - ;; (line-padding (when (eq which-key-show-prefix 'left) - ;; (s-repeat prefix-len " "))) (avl-lines max-lines) - (avl-width max-width) + (avl-width (- (+ 1 max-width) prefix-width)); we get 1 back for not putting a space after the last column (rem-key-cns key-cns) (n-col-lines (min avl-lines n-keys)) (act-n-lines n-col-lines) ; n-col-lines in first column - (act-width 0) - (col-i 0) + (all-columns (list (mapcar (lambda (i) (if (> i 1) (s-repeat prefix-width " ") "")) + (number-sequence 1 n-col-lines)))) + (act-width prefix-width) (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face)) col-key-cns col-key-width col-desc-width col-width col-split done - all-columns new-column page) + n-columns new-column page) + (message "ok") (while (not done) (setq col-split (-split-at n-col-lines rem-key-cns) col-key-cns (car col-split) rem-key-cns (cadr col-split) n-col-lines (min avl-lines (length rem-key-cns)) col-key-width (cl-reduce (lambda (x y) - (max x (length (substring-no-properties (car y))))) - col-key-cns :initial-value 0) + (max x (length (substring-no-properties (car y))))) + col-key-cns :initial-value 0) col-desc-width (cl-reduce (lambda (x y) - (max x (length (substring-no-properties (cdr y))))) - col-key-cns :initial-value 0) - col-width (+ 4 (length (substring-no-properties sep-w-face)) + (max x (length (substring-no-properties (cdr y))))) + col-key-cns :initial-value 0) + col-width (+ 3 (length (substring-no-properties sep-w-face)) col-key-width col-desc-width) new-column (mapcar (lambda (k) (concat (s-repeat (- col-key-width (length (substring-no-properties (car k)))) " ") (car k) " " sep-w-face " " (cdr k) - (s-repeat (- col-desc-width (length (substring-no-properties (cdr k)))) " ") - " ")) + (s-repeat (- col-desc-width (length (substring-no-properties (cdr k)))) " "))) col-key-cns)) (if (<= col-width avl-width) (setq all-columns (push new-column all-columns) @@ -592,16 +591,17 @@ the maximum number of lines availabel in the target buffer." avl-width (- avl-width col-width)) (setq done t)) (when (<= (length rem-key-cns) 0) (setq done t))) - (setq all-columns (reverse all-columns)) + (setq all-columns (reverse all-columns) + n-columns (length all-columns)) (dotimes (i act-n-lines) - (dotimes (j (length all-columns)) + (dotimes (j n-columns) (setq page (concat page (nth i (nth j all-columns)) - (when (and (not (= i (- act-n-lines 1))) - (= j (- (length all-columns) 1))) "\n"))))) + (if (not (= j (- n-columns 1))) " " + (when (not (= i (- act-n-lines 1))) "\n")))))) (list page act-n-lines act-width rem-key-cns))) -(defun which-key/create-page (vertical max-lines max-width key-cns) - (let* ((first-try (which-key/create-page-vertical max-lines max-width key-cns)) +(defun which-key/create-page (vertical max-lines max-width prefix-width key-cns) + (let* ((first-try (which-key/create-page-vertical max-lines max-width prefix-width key-cns)) (n-rem-keys (length (nth 3 first-try))) (next-try-lines max-lines) prev-try prev-n-rem-keys next-try found) @@ -611,57 +611,30 @@ the maximum number of lines availabel in the target buffer." (while (not found) (setq prev-try next-try next-try-lines (- next-try-lines 1) - next-try (which-key/create-page-vertical next-try-lines max-width key-cns) + next-try (which-key/create-page-vertical next-try-lines max-width prefix-width key-cns) n-rem-keys (length (nth 3 next-try)) found (or (= next-try-lines 0) (> n-rem-keys 0)))) prev-try))) -;; start on binary search (not correct yet) -;; n-rem-keys is 0, try to get a better fit -;; (while (not found) -;; (setq next-try-lines (/ (+ minline maxline) 2) -;; next-try (which-key/create-page-vertical next-try-lines max-width key-cns) -;; n-rem-keys (length (nth 3 next-try))) -;; (if (= n-rem-keys 0) -;; ;; not far enough -;; (setq maxline (- next-try-lines 1)) -;; ;; too far -;; (setq minline (+ next-try-lines 1)) -;; ) -;; next-try-lines (if (= n-rem-keys 0) -;; (/ (+ next-try-lines 1) 2) -;; (/ (+ max-lines next-try-lines) 2))) - - (defun which-key/populate-buffer (prefix-keys formatted-keys sel-win-width) "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." (let* ((vertical (and (eq which-key-popup-type 'side-window) (member which-key-side-window-location '(left right)))) - (which-key-show-prefix nil) ; kill prefix for now - ;; (prefix-w-face (which-key/propertize-key prefix-keys)) - ;; (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) - ;; (prefix-string (when which-key-show-prefix - ;; (if (eq which-key-show-prefix 'left) - ;; (concat prefix-w-face " ") - ;; (concat prefix-w-face "-\n")))) - (prefix-string nil) + (prefix-w-face (which-key/propertize-key prefix-keys)) + (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) + (prefix-string (when which-key-show-prefix + (if (eq which-key-show-prefix 'left) + (concat prefix-w-face " ") + (concat prefix-w-face "-\n")))) (n-keys (length formatted-keys)) (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-height (when (car max-dims) (car max-dims))) - (avl-width (if (cdr max-dims) - (if (eq which-key-show-prefix 'left) - (- (cdr max-dims) prefix-len) - (cdr max-dims)) 0)) - ;; (act-width (+ (* n-columns column-width) - ;; (if (eq which-key-show-prefix 'left) prefix-len 0))) - ;; (avl-lines/page (which-key/available-lines)) - ;; (max-keys/page (when max-height (* n-columns max-height))) - ;; (n-pages (if (> max-keys/page 0) - ;; (ceiling (/ (float n-keys) max-keys/page)) 1)) + (prefix-width (if (eq which-key-show-prefix 'left) prefix-len 0)) + (avl-width (when (cdr max-dims) (- (cdr max-dims) prefix-width))) (keys-rem formatted-keys) pages first-page first-page-str page-res) (while keys-rem - (setq page-res (which-key/create-page vertical max-height avl-width keys-rem) + (setq page-res (which-key/create-page vertical max-height avl-width prefix-width keys-rem) pages (push page-res pages) keys-rem (nth 3 page-res))) ;; not doing anything with other pages for now @@ -680,11 +653,6 @@ the maximum number of lines availabel in the target buffer." (insert first-page-str) (goto-char (point-min)))) (cons (nth 1 first-page) (nth 2 first-page))))) -;; (if (<= n-keys 0) -;; (message "Can't display which-key buffer: There are no keys to show.") -;; (message "Can't display which-key buffer: A minimum width of %s chars is required, but your settings only allow for %s chars." column-width avl-width) -;; ) -;; (cons 0 act-width))) (defun which-key/maybe-replace-key-based (string keys) (let* ((alist which-key-key-based-description-replacement-alist) commit 1797db7255b25d7aac4449f22ca1a52a3cb0ebae Author: Justin Burkett Date: Fri Jul 10 14:51:45 2015 -0400 Require dash diff --git a/which-key.el b/which-key.el index 6ff81dfc2e0..01e2920f72d 100644 --- a/which-key.el +++ b/which-key.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/justbur/which-key/ ;; Version: 0.1 ;; Keywords: -;; Package-Requires: ((emacs "24.3") (s "1.9.0")) +;; Package-Requires: ((emacs "24.3") (s "1.9.0") (dash "2.11.0")) ;;; Commentary: ;; @@ -23,6 +23,7 @@ (require 'cl-lib) (require 's) +(require 'dash) (defgroup which-key nil "Customization options for which-key-mode") (defcustom which-key-idle-delay 1 commit 13a4fce0918d741b790e52f8b62321da28f0f61a Merge: 0526b8b1675 5ed3e543665 Author: Justin Burkett Date: Fri Jul 10 14:47:09 2015 -0400 Merge pull request #26 from bmag/fill-columns Use toggle-truncate-lines; reduce -> cl-reduce commit 7e2c91ed622035220bc2ee6f3ef031b4e0c9ba2d Merge: 654afeb8597 2df42e2da4d Author: Justin Burkett Date: Fri Jul 10 14:46:14 2015 -0400 Merge pull request #27 from bmag/master Fix some defcustoms commit 2df42e2da4db0235e826a4f4c29af9d906d86d71 Author: Bar Magal Date: Fri Jul 10 21:29:58 2015 +0300 Fix some defcustoms diff --git a/which-key.el b/which-key.el index 4605e73cc1c..0efae1cd8cc 100644 --- a/which-key.el +++ b/which-key.el @@ -25,7 +25,7 @@ (require 's) (defgroup which-key nil "Customization options for which-key-mode") -(defcustom which-key-idle-delay 1 +(defcustom which-key-idle-delay 1.0 "Delay (in seconds) for which-key buffer to popup." :group 'which-key :type 'float) @@ -80,7 +80,7 @@ emacs-lisp-mode." "These keys will automatically be truncated to one character and have `which-key-special-key-face' applied to them." :group 'which-key - :type '(list string)) + :type '(repeat string)) (defcustom which-key-buffer-name "*which-key*" "Name of which-key buffer." :group 'which-key @@ -90,23 +90,23 @@ and have `which-key-special-key-face' applied to them." Possible choices are left (the default), top and nil. Nil turns the feature off." :group 'which-key - :type '(radio (symbol :tag "Left of keys" left) - (symbol :tag "In first line" top) + :type '(radio (const :tag "Left of keys" left) + (const :tag "In first line" top) (const :tag "Hide" nil))) (defcustom which-key-popup-type 'minibuffer "Supported types are minibuffer, side-window and frame." :group 'which-key - :type '(radio (symbol :tag "Show in minibuffer" minibuffer) - (symbol :tag "Show in side window" side-window) - (symbol :tag "Show in popup frame" frame))) + :type '(radio (const :tag "Show in minibuffer" minibuffer) + (const :tag "Show in side window" side-window) + (const :tag "Show in popup frame" frame))) (defcustom which-key-side-window-location 'right "Location of which-key popup when `which-key-popup-type' is side-window. Should be one of top, bottom, left or right." :group 'which-key - :type '(radio (symbol right) - (symbol bottom) - (symbol left) - (symbol top))) + :type '(radio (const right) + (const bottom) + (const left) + (const top))) (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. commit 5ed3e543665b1a25e47d1c72f4ad6ac497d734b7 Author: Bar Magal Date: Fri Jul 10 20:57:34 2015 +0300 Check frame width in a non-buggy way `(window-width (frame-root-window))` throws an error when the frame is split (frame's root window is not live). diff --git a/which-key.el b/which-key.el index e0f335a4b8d..6ff81dfc2e0 100644 --- a/which-key.el +++ b/which-key.el @@ -524,7 +524,7 @@ of the intended popup." (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)) - (window-width (frame-root-window))))) + (frame-width)))) (defun which-key/frame-max-dimensions () (cons which-key-frame-max-height which-key-frame-max-width)) commit b399f3e02ef97cf8a07e6f89ca4cc4135f921111 Author: Bar Magal Date: Fri Jul 10 20:30:30 2015 +0300 Use toggle-truncate-lines; reduce -> cl-reduce Enabling toggle-truncate-lines in which-key--buffer, to avoid empty lines when the window is just a bit too narrow. diff --git a/which-key.el b/which-key.el index a684756c7c0..e0f335a4b8d 100644 --- a/which-key.el +++ b/which-key.el @@ -198,6 +198,7 @@ Used when `which-key-popup-type' is frame.") "Create buffer for which-key." (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer + (toggle-truncate-lines 1) (setq-local cursor-type nil) (setq-local cursor-in-non-selected-windows nil) (setq-local mode-line-format nil)) @@ -569,10 +570,10 @@ the maximum number of lines availabel in the target buffer." col-key-cns (car col-split) rem-key-cns (cadr col-split) n-col-lines (min avl-lines (length rem-key-cns)) - col-key-width (reduce (lambda (x y) + col-key-width (cl-reduce (lambda (x y) (max x (length (substring-no-properties (car y))))) col-key-cns :initial-value 0) - col-desc-width (reduce (lambda (x y) + col-desc-width (cl-reduce (lambda (x y) (max x (length (substring-no-properties (cdr y))))) col-key-cns :initial-value 0) col-width (+ 4 (length (substring-no-properties sep-w-face)) commit 0526b8b16750a09d48e5257575706db11bc96c7c Author: Justin Burkett Date: Fri Jul 10 12:13:50 2015 -0400 Bring back error message for too small of a frame diff --git a/which-key.el b/which-key.el index 088f55436bd..a684756c7c0 100644 --- a/which-key.el +++ b/which-key.el @@ -283,8 +283,8 @@ bottom." "Fill which-key--buffer with key descriptions and reformat. Finally, show the buffer." (let ((prefix-keys (this-single-command-keys))) -;; (when (> (length prefix-keys) 0) (message "key: %s" (key-description prefix-keys))) -;; (when (> (length prefix-keys) 0) (message "key binding: %s" (key-binding prefix-keys))) + ;; (when (> (length prefix-keys) 0) (message "key: %s" (key-description prefix-keys))) + ;; (when (> (length prefix-keys) 0) (message "key binding: %s" (key-binding prefix-keys))) (when (and (> (length prefix-keys) 0) (keymapp (key-binding prefix-keys))) (let* ((buf (current-buffer)) @@ -516,7 +516,7 @@ of the intended popup." ;; height (if (member which-key-side-window-location '(left right)) (- (frame-height) (window-text-height (minibuffer-window)) 1) ;; 1 is a kludge to make sure there is no overlap - ;; (window-mode-line-height which-key--window)) + ;; (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 @@ -657,8 +657,6 @@ the maximum number of lines availabel in the target buffer." ;; (n-pages (if (> max-keys/page 0) ;; (ceiling (/ (float n-keys) max-keys/page)) 1)) (keys-rem formatted-keys) - (act-height 0) - (act-width 0) pages first-page first-page-str page-res) (while keys-rem (setq page-res (which-key/create-page vertical max-height avl-width keys-rem) @@ -667,17 +665,19 @@ the maximum number of lines availabel in the target buffer." ;; not doing anything with other pages for now (setq pages (reverse pages) first-page (car pages) - first-page-str (concat prefix-string (car first-page)) - act-height (nth 1 first-page) - act-width (nth 2 first-page)) - ;; (when (> (length pages) 1) (setq first-page (concat first-page "..."))) - (if (eq which-key-popup-type 'minibuffer) - (let (message-log-max) (message "%s" first-page-str)) - (with-current-buffer which-key--buffer - (erase-buffer) - (insert first-page-str) - (goto-char (point-min)))) - (cons act-height act-width))) + first-page-str (concat prefix-string (car first-page))) + (if (= 0 (length first-page-str)) + (progn + (message "which-key can't show keys: The settings and/or frame size are too restrictive.") + (cons 0 0)) + ;; (when (> (length pages) 1) (setq first-page (concat first-page "..."))) + (if (eq which-key-popup-type 'minibuffer) + (let (message-log-max) (message "%s" first-page-str)) + (with-current-buffer which-key--buffer + (erase-buffer) + (insert first-page-str) + (goto-char (point-min)))) + (cons (nth 1 first-page) (nth 2 first-page))))) ;; (if (<= n-keys 0) ;; (message "Can't display which-key buffer: There are no keys to show.") ;; (message "Can't display which-key buffer: A minimum width of %s chars is required, but your settings only allow for %s chars." column-width avl-width) commit ea115fc5dd84d1b28351661ad9b31bbc852bb662 Author: Justin Burkett Date: Fri Jul 10 11:56:15 2015 -0400 Fix bug (layout wasn't going to 1 line) diff --git a/which-key.el b/which-key.el index f15bcc18fe3..088f55436bd 100644 --- a/which-key.el +++ b/which-key.el @@ -611,7 +611,7 @@ the maximum number of lines availabel in the target buffer." next-try-lines (- next-try-lines 1) next-try (which-key/create-page-vertical next-try-lines max-width key-cns) n-rem-keys (length (nth 3 next-try)) - found (or (= next-try-lines 1) (> n-rem-keys 0)))) + found (or (= next-try-lines 0) (> n-rem-keys 0)))) prev-try))) ;; start on binary search (not correct yet) commit 5f5fc22acfbd56d998efd4b73648ccd53d694da4 Author: Justin Burkett Date: Fri Jul 10 10:41:30 2015 -0400 Fill columns first with variable column width Allows for more compact layout diff --git a/which-key.el b/which-key.el index 4605e73cc1c..f15bcc18fe3 100644 --- a/which-key.el +++ b/which-key.el @@ -289,13 +289,11 @@ Finally, show the buffer." (keymapp (key-binding prefix-keys))) (let* ((buf (current-buffer)) ;; get formatted key bindings - (fmt-width-cons (which-key/get-formatted-key-bindings buf prefix-keys)) - (formatted-keys (car fmt-width-cons)) - (column-width (cdr fmt-width-cons)) + (formatted-keys (which-key/get-formatted-key-bindings buf prefix-keys)) ;; populate target buffer (popup-act-dim (which-key/populate-buffer (key-description prefix-keys) - formatted-keys column-width (window-width)))) + formatted-keys (window-width)))) ;; show buffer (which-key/show-popup popup-act-dim))))) ;; command finished maybe close the window @@ -547,80 +545,144 @@ of the intended popup." desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted :test (lambda (x y) (string-equal (car x) (car y)))))) - (which-key/format-matches unformatted (key-description key)))) + (which-key/format-and-replace unformatted (key-description key)))) -(defun which-key/create-page (prefix-len max-lines n-columns keys) +(defun which-key/create-page-vertical (max-lines max-width key-cns) "Format KEYS into string representing a single page of text. N-COLUMNS is the number of text columns to use and MAX-LINES is the maximum number of lines availabel in the target buffer." - (let* ((n-keys (length keys)) - (n-lines (min (ceiling (/ (float n-keys) n-columns)) max-lines)) - (line-padding (when (eq which-key-show-prefix 'left) - (s-repeat prefix-len " "))) - lines) - (dotimes (i n-lines) - (setq lines - (push (cl-subseq keys (* i n-columns) - (min n-keys (* (1+ i) n-columns))) - lines))) - (mapconcat (lambda (x) (apply 'concat x)) - (reverse lines) (concat "\n" line-padding)))) - -(defun which-key/populate-buffer (prefix-keys formatted-keys - column-width sel-win-width) + (let* ((n-keys (length key-cns)) + ;; (line-padding (when (eq which-key-show-prefix 'left) + ;; (s-repeat prefix-len " "))) + (avl-lines max-lines) + (avl-width max-width) + (rem-key-cns key-cns) + (n-col-lines (min avl-lines n-keys)) + (act-n-lines n-col-lines) ; n-col-lines in first column + (act-width 0) + (col-i 0) + (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face)) + col-key-cns col-key-width col-desc-width col-width col-split done + all-columns new-column page) + (while (not done) + (setq col-split (-split-at n-col-lines rem-key-cns) + col-key-cns (car col-split) + rem-key-cns (cadr col-split) + n-col-lines (min avl-lines (length rem-key-cns)) + col-key-width (reduce (lambda (x y) + (max x (length (substring-no-properties (car y))))) + col-key-cns :initial-value 0) + col-desc-width (reduce (lambda (x y) + (max x (length (substring-no-properties (cdr y))))) + col-key-cns :initial-value 0) + col-width (+ 4 (length (substring-no-properties sep-w-face)) + col-key-width col-desc-width) + new-column (mapcar + (lambda (k) + (concat (s-repeat (- col-key-width (length (substring-no-properties (car k)))) " ") + (car k) " " sep-w-face " " (cdr k) + (s-repeat (- col-desc-width (length (substring-no-properties (cdr k)))) " ") + " ")) + col-key-cns)) + (if (<= col-width avl-width) + (setq all-columns (push new-column all-columns) + act-width (+ act-width col-width) + avl-width (- avl-width col-width)) + (setq done t)) + (when (<= (length rem-key-cns) 0) (setq done t))) + (setq all-columns (reverse all-columns)) + (dotimes (i act-n-lines) + (dotimes (j (length all-columns)) + (setq page (concat page (nth i (nth j all-columns)) + (when (and (not (= i (- act-n-lines 1))) + (= j (- (length all-columns) 1))) "\n"))))) + (list page act-n-lines act-width rem-key-cns))) + +(defun which-key/create-page (vertical max-lines max-width key-cns) + (let* ((first-try (which-key/create-page-vertical max-lines max-width key-cns)) + (n-rem-keys (length (nth 3 first-try))) + (next-try-lines max-lines) + prev-try prev-n-rem-keys next-try found) + (if (or vertical (> n-rem-keys 0) (= max-lines 1)) + first-try + ;; do a simple search for now (TODO: Implement binary search) + (while (not found) + (setq prev-try next-try + next-try-lines (- next-try-lines 1) + next-try (which-key/create-page-vertical next-try-lines max-width key-cns) + n-rem-keys (length (nth 3 next-try)) + found (or (= next-try-lines 1) (> n-rem-keys 0)))) + prev-try))) + +;; start on binary search (not correct yet) +;; n-rem-keys is 0, try to get a better fit +;; (while (not found) +;; (setq next-try-lines (/ (+ minline maxline) 2) +;; next-try (which-key/create-page-vertical next-try-lines max-width key-cns) +;; n-rem-keys (length (nth 3 next-try))) +;; (if (= n-rem-keys 0) +;; ;; not far enough +;; (setq maxline (- next-try-lines 1)) +;; ;; too far +;; (setq minline (+ next-try-lines 1)) +;; ) +;; next-try-lines (if (= n-rem-keys 0) +;; (/ (+ next-try-lines 1) 2) +;; (/ (+ max-lines next-try-lines) 2))) + + +(defun which-key/populate-buffer (prefix-keys formatted-keys sel-win-width) "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." - (let* ((vertical-mode (and (eq which-key-popup-type 'side-window) - (member which-key-side-window-location '(left right)))) - (prefix-w-face (which-key/propertize-key prefix-keys)) - (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) - (prefix-string (when which-key-show-prefix - (if (eq which-key-show-prefix 'left) - (concat prefix-w-face " ") - (concat prefix-w-face "-\n")))) + (let* ((vertical (and (eq which-key-popup-type 'side-window) + (member which-key-side-window-location '(left right)))) + (which-key-show-prefix nil) ; kill prefix for now + ;; (prefix-w-face (which-key/propertize-key prefix-keys)) + ;; (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) + ;; (prefix-string (when which-key-show-prefix + ;; (if (eq which-key-show-prefix 'left) + ;; (concat prefix-w-face " ") + ;; (concat prefix-w-face "-\n")))) + (prefix-string nil) (n-keys (length formatted-keys)) (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-height (when (car max-dims) (car max-dims))) - (max-width-for-columns (if (cdr max-dims) - (if (eq which-key-show-prefix 'left) - (- (cdr max-dims) prefix-len) - (cdr max-dims)) 0)) - (n-columns (/ max-width-for-columns column-width)) ;; integer division - (n-columns (if vertical-mode - ;; use up vertical space first if possible - (min n-columns (ceiling (/ (float n-keys) max-height))) - n-columns)) - (act-width (+ (* n-columns column-width) - (if (eq which-key-show-prefix 'left) prefix-len 0))) + (avl-width (if (cdr max-dims) + (if (eq which-key-show-prefix 'left) + (- (cdr max-dims) prefix-len) + (cdr max-dims)) 0)) + ;; (act-width (+ (* n-columns column-width) + ;; (if (eq which-key-show-prefix 'left) prefix-len 0))) ;; (avl-lines/page (which-key/available-lines)) - (max-keys/page (when max-height (* n-columns max-height))) - (n-pages (if (> max-keys/page 0) - (ceiling (/ (float n-keys) max-keys/page)) 1)) - pages act-height first-page) - (if (and (> n-keys 0) (> n-columns 0)) - (progn - (dotimes (p n-pages) - (setq pages - (push (which-key/create-page - prefix-len max-height n-columns - (cl-subseq formatted-keys (* p max-keys/page) - (min (* (1+ p) max-keys/page) n-keys))) pages))) - ;; not doing anything with other pages for now - (setq pages (reverse pages) - first-page (concat prefix-string (car pages)) - act-height (1+ (s-count-matches "\n" first-page))) - ;; (when (> (length pages) 1) (setq first-page (concat first-page "..."))) - (if (eq which-key-popup-type 'minibuffer) - (let (message-log-max) (message "%s" first-page)) - (with-current-buffer which-key--buffer - (erase-buffer) - (insert first-page) - (goto-char (point-min)))) - (cons act-height act-width)) - (if (<= n-keys 0) - (message "Can't display which-key buffer: There are no keys to show.") - (message "Can't display which-key buffer: A minimum width of %s chars is required, but your settings only allow for %s chars." column-width max-width-for-columns) - ) - (cons 0 act-width)))) + ;; (max-keys/page (when max-height (* n-columns max-height))) + ;; (n-pages (if (> max-keys/page 0) + ;; (ceiling (/ (float n-keys) max-keys/page)) 1)) + (keys-rem formatted-keys) + (act-height 0) + (act-width 0) + pages first-page first-page-str page-res) + (while keys-rem + (setq page-res (which-key/create-page vertical max-height avl-width keys-rem) + pages (push page-res pages) + keys-rem (nth 3 page-res))) + ;; not doing anything with other pages for now + (setq pages (reverse pages) + first-page (car pages) + first-page-str (concat prefix-string (car first-page)) + act-height (nth 1 first-page) + act-width (nth 2 first-page)) + ;; (when (> (length pages) 1) (setq first-page (concat first-page "..."))) + (if (eq which-key-popup-type 'minibuffer) + (let (message-log-max) (message "%s" first-page-str)) + (with-current-buffer which-key--buffer + (erase-buffer) + (insert first-page-str) + (goto-char (point-min)))) + (cons act-height act-width))) +;; (if (<= n-keys 0) +;; (message "Can't display which-key buffer: There are no keys to show.") +;; (message "Can't display which-key buffer: A minimum width of %s chars is required, but your settings only allow for %s chars." column-width avl-width) +;; ) +;; (cons 0 act-width))) (defun which-key/maybe-replace-key-based (string keys) (let* ((alist which-key-key-based-description-replacement-alist) @@ -662,51 +724,38 @@ non-nil regexp is used in the replacements." (concat (substring desc 0 which-key-max-description-length) "..") desc)) -(defun which-key/format-matches (unformatted prefix-keys) +(defun which-key/format-and-replace (unformatted prefix-keys) "Turn each key-desc-cons in UNFORMATTED into formatted strings (including text properties), and pad with spaces so that all are a uniform length. Replacements are performed using the key and description replacement alists." - (let ((max-key-width 0) - (max-desc-width 0) - (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face)) - (sep-width (length which-key-separator)) - after-replacements) + (let ((max-key-width 0)) ;(max-desc-width 0) ;; first replace and apply faces - (setq after-replacements - (mapcar - (lambda (key-desc-cons) - (let* ((key (car key-desc-cons)) - (desc (cdr key-desc-cons)) - (keys (concat prefix-keys " " key)) - (key (which-key/maybe-replace key which-key-key-replacement-alist)) - (desc (which-key/maybe-replace desc which-key-description-replacement-alist)) - (desc (which-key/maybe-replace-key-based desc keys)) - (group (string-match-p "^group:" desc)) - (desc (if group (substring desc 6) desc)) - (prefix (string-match-p "^Prefix" desc)) - (desc (if (or prefix group) (concat "+" desc) desc)) - (desc-face (if (or prefix group) - 'which-key-group-description-face - 'which-key-command-description-face)) - (desc (which-key/truncate-description desc)) - (key-w-face (which-key/propertize-key key)) - (desc-w-face (propertize desc 'face desc-face)) - (key-width (length (substring-no-properties key-w-face))) - (desc-width (length (substring-no-properties desc-w-face)))) - (setq max-key-width (max key-width max-key-width)) - (setq max-desc-width (max desc-width max-desc-width)) - (cons key-w-face desc-w-face))) - unformatted)) - ;; pad to max key-width and max desc-width - (cons - (mapcar (lambda (x) - (concat (s-pad-left max-key-width " " (car x)) - " " sep-w-face " " - (s-pad-right max-desc-width " " (cdr x)) - " ")) - after-replacements) - (+ 3 max-key-width sep-width max-desc-width )))) + (mapcar + (lambda (key-desc-cons) + (let* ((key (car key-desc-cons)) + (desc (cdr key-desc-cons)) + (keys (concat prefix-keys " " key)) + (key (which-key/maybe-replace key which-key-key-replacement-alist)) + (desc (which-key/maybe-replace desc which-key-description-replacement-alist)) + (desc (which-key/maybe-replace-key-based desc keys)) + (group (string-match-p "^group:" desc)) + (desc (if group (substring desc 6) desc)) + (prefix (string-match-p "^Prefix" desc)) + (desc (if (or prefix group) (concat "+" desc) desc)) + (desc-face (if (or prefix group) + 'which-key-group-description-face + 'which-key-command-description-face)) + (desc (which-key/truncate-description desc)) + (key-w-face (which-key/propertize-key key)) + (desc-w-face (propertize desc 'face desc-face)) + (key-width (length (substring-no-properties key-w-face)))) + ;; (desc-width (length (substring-no-properties desc-w-face)))) + (setq max-key-width (max key-width max-key-width)) + ;; (setq max-desc-width (max desc-width max-desc-width)) + (cons key-w-face desc-w-face))) + unformatted))) +;; pad to max key-width and max desc-width (provide 'which-key) commit 654afeb8597607ceedd40085360b2595c17381e2 Author: Justin Burkett Date: Thu Jul 9 20:49:37 2015 -0400 Fix bug in populate buffer diff --git a/which-key.el b/which-key.el index cbc3a2b87b1..4605e73cc1c 100644 --- a/which-key.el +++ b/which-key.el @@ -569,7 +569,8 @@ the maximum number of lines availabel in the target buffer." (defun which-key/populate-buffer (prefix-keys formatted-keys column-width sel-win-width) "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." - (let* ((vertical-mode (member which-key-side-window-location '(left right))) + (let* ((vertical-mode (and (eq which-key-popup-type 'side-window) + (member which-key-side-window-location '(left right)))) (prefix-w-face (which-key/propertize-key prefix-keys)) (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) (prefix-string (when which-key-show-prefix commit 732b0c32c93771ebd075d051e81a40af2fd219b1 Author: Justin Burkett Date: Thu Jul 9 20:46:49 2015 -0400 Try out status-key option diff --git a/which-key.el b/which-key.el index cbc3a2b87b1..c0395451800 100644 --- a/which-key.el +++ b/which-key.el @@ -569,14 +569,17 @@ the maximum number of lines availabel in the target buffer." (defun which-key/populate-buffer (prefix-keys formatted-keys column-width sel-win-width) "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." - (let* ((vertical-mode (member which-key-side-window-location '(left right))) + (let* ((vertical-mode (and (eq which-key-popup-type 'side-window) + (member which-key-side-window-location '(left right)))) + (n-status-key 1) + (which-key-show-prefix nil) (prefix-w-face (which-key/propertize-key prefix-keys)) (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) (prefix-string (when which-key-show-prefix (if (eq which-key-show-prefix 'left) (concat prefix-w-face " ") (concat prefix-w-face "-\n")))) - (n-keys (length formatted-keys)) + (n-keys (+ n-status-key (length formatted-keys))) (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-height (when (car max-dims) (car max-dims))) (max-width-for-columns (if (cdr max-dims) @@ -590,11 +593,18 @@ the maximum number of lines availabel in the target buffer." n-columns)) (act-width (+ (* n-columns column-width) (if (eq which-key-show-prefix 'left) prefix-len 0))) - ;; (avl-lines/page (which-key/available-lines)) (max-keys/page (when max-height (* n-columns max-height))) (n-pages (if (> max-keys/page 0) (ceiling (/ (float n-keys) max-keys/page)) 1)) + (n-keys-pg1 (- (if (= 1 n-pages) n-keys max-keys/page) n-status-key)) + (count (format "- [%s/%s]" n-keys-pg1 (- n-keys n-status-key))) + ;; (count-len (length count)) + (status-key (concat prefix-keys count)) + (status-key (s-pad-right column-width " " status-key)) + (status-key (propertize status-key 'face 'font-lock-comment-face)) + (fmtd-keys (if (= 1 n-status-key) (push status-key formatted-keys) formatted-keys)) pages act-height first-page) + (message "%s" status-key) (if (and (> n-keys 0) (> n-columns 0)) (progn (dotimes (p n-pages) commit 9ada9d09e34ef03cde184b32af42834e833b85b4 Author: Justin Burkett Date: Thu Jul 9 16:22:16 2015 -0400 Fix #6: TODO for defcustom diff --git a/which-key.el b/which-key.el index 282d9f76880..cbc3a2b87b1 100644 --- a/which-key.el +++ b/which-key.el @@ -24,32 +24,45 @@ (require 'cl-lib) (require 's) -(defvar which-key-idle-delay 1 - "Delay (in seconds) for which-key buffer to popup.") -(defvar which-key-echo-keystrokes +(defgroup which-key nil "Customization options for which-key-mode") +(defcustom which-key-idle-delay 1 + "Delay (in seconds) for which-key buffer to popup." + :group 'which-key + :type 'float) +(defcustom which-key-echo-keystrokes (min echo-keystrokes (/ (float which-key-idle-delay) 4)) "Value to use for echo-keystrokes. This only applies when `which-key-popup-type' is minibuffer. It needs to be less than `which-key-idle-delay' or else the echo will erase the which-key -popup.") -(defvar which-key-max-description-length 27 +popup." + :group 'which-key + :type 'float) +(defcustom which-key-max-description-length 27 "Truncate the description of keys to this length. Also adds -\"..\".") -(defvar which-key-separator "→" - "Separator to use between key and description.") -(defvar which-key-key-replacement-alist +\"..\"." + :group 'which-key + :type 'integer) +(defcustom which-key-separator "→" + "Separator to use between key and description." + :group 'which-key + :type 'string) +(defcustom which-key-key-replacement-alist '(("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") ("left" . "←") ("right" . "→")) - "The strings in the car of each cons are replaced with the + "The strings in the car of each cons are replaced with the strings in the cdr for each key. Elisp regexp can be used as -in the first example.") -(defvar which-key-description-replacement-alist +in the first example." + :group 'which-key + :type '(alist :key-type regexp :value-type string)) +(defcustom which-key-description-replacement-alist '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1")) "See `which-key-key-replacement-alist'. This is a list of lists for replacing descriptions. The second one removes \"namespace/\" from \"namespace/function\". This is a convention for naming functions but not a rule, so remove this replacement if it -becomes problematic.") -(defvar which-key-key-based-description-replacement-alist '() +becomes problematic." + :group 'which-key + :type '(alist :key-type regexp :value-type string)) +(defcustom which-key-key-based-description-replacement-alist '() "Each item in the list is a cons cell. The car of each cons cell is either a string like \"C-c\", in which case it's interpreted as a key sequence or a value of `major-mode'. Here @@ -61,35 +74,61 @@ are two examples: In the first case the description of the key sequence \"SPC f f\" is overwritten with \"find files\". The second case works the same way using the alist matched when `major-mode' is -emacs-lisp-mode.") -(defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") +emacs-lisp-mode." +:group 'which-key) +(defcustom which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") "These keys will automatically be truncated to one character -and have `which-key-special-key-face' applied to them.") -(defvar which-key-buffer-name "*which-key*" - "Name of which-key buffer.") -(defvar which-key-show-prefix 'left - "Whether to and where to display the current prfix sequence. +and have `which-key-special-key-face' applied to them." + :group 'which-key + :type '(list string)) +(defcustom which-key-buffer-name "*which-key*" + "Name of which-key buffer." + :group 'which-key + :type 'string) +(defcustom which-key-show-prefix 'left + "Whether to and where to display the current prefix sequence. Possible choices are left (the default), top and nil. Nil turns -the feature off.") -(defvar which-key-popup-type 'minibuffer - "Supported types are minibuffer, side-window and frame.") -(defvar which-key-side-window-location 'right +the feature off." + :group 'which-key + :type '(radio (symbol :tag "Left of keys" left) + (symbol :tag "In first line" top) + (const :tag "Hide" nil))) +(defcustom which-key-popup-type 'minibuffer + "Supported types are minibuffer, side-window and frame." + :group 'which-key + :type '(radio (symbol :tag "Show in minibuffer" minibuffer) + (symbol :tag "Show in side window" side-window) + (symbol :tag "Show in popup frame" frame))) +(defcustom which-key-side-window-location 'right "Location of which-key popup when `which-key-popup-type' is -side-window. Should be one of top, bottom, left or right.") -(defvar which-key-side-window-max-width 0.333 +side-window. Should be one of top, bottom, left or right." + :group 'which-key + :type '(radio (symbol right) + (symbol bottom) + (symbol left) + (symbol top))) +(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.") -(defvar which-key-side-window-max-height 0.25 +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.") -(defvar which-key-frame-max-width 60 - "Maximum width of which-key popup when type is frame.") -(defvar which-key-frame-max-height 20 - "Maximum height of which-key popup when type is frame.") +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) ;; Faces (defface which-key-key-face commit 62f409a1025b8e15b44a2b2141af92bd6196ba5b Author: Justin Burkett Date: Thu Jul 9 13:11:05 2015 -0400 Make variables stand-out in readme diff --git a/README.org b/README.org index f785ceb5474..e523a33327d 100644 --- a/README.org +++ b/README.org @@ -1,7 +1,7 @@ Rewrite of guide-key-mode for emacs. * Install -Add which-key.el to your load-path and require. Some thing like +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") @@ -21,8 +21,8 @@ settings (which are configurable but not well documented at the moment). By default which-key makes substitutions for text all with the aim of saving space. The most noticeable are the "special keys" like SPC, TAB, RET, etc. This can be turned off, but the default is to truncate these keys to one character -and display them using inverse-video (flips foreground and background colors). -You can see the effect in the screenshots. +and display them using =:inverse-video= (flips foreground and background +colors). You can see the effect in the screenshots. There are other substitution abilities included, which are quite flexible (ability to use regexp for example). This makes which-key very customizable. @@ -38,7 +38,7 @@ Take over the minibuffer. Setup by default, but you can also use [[./img/which-key-minibuffer.png]] Note the maximum height of the minibuffer is controlled through the built-in -variable max-mini-window-height. +variable =max-mini-window-height=. ** Side Window Right Option Popup side window on right. For defaults use @@ -71,7 +71,7 @@ Popup side window on bottom. For defaults use where possible. 3. Add support for replacement lists to modify key descriptions on the fly. Currently you can replace in the key or description field using regexp, and - using a key sequence (like "C-x 1") to fully replace the description (the + using a key sequence (like ="C-x 1"=) to fully replace the description (the latter can target major modes, too). ** Incomplete and Planned 1. Come up with creative ways to fit more keys in buffer while still maintaining commit f60e6d979d3033b4183360f30e0836f3102deb89 Author: Justin Burkett Date: Thu Jul 9 12:58:45 2015 -0400 Fix add replacement functions diff --git a/which-key.el b/which-key.el index 094f3324891..282d9f76880 100644 --- a/which-key.el +++ b/which-key.el @@ -205,33 +205,37 @@ bottom." ;; Helper functions to modify replacement lists. -(defun which-key//add-key-based-replacements (alist key repl &rest more) - (while key - (when (or (not (stringp key)) (not (stringp repl))) - (error "KEY and REPL should be strings")) - (cl-pushnew (cons key repl) alist - :test (lambda (x y) (string-equal (car x) (car y)))) - (setq key (pop more) - repl (pop more))) +(defun which-key//add-key-based-replacements (alist key repl) + (when (or (not (stringp key)) (not (stringp repl))) + (error "KEY and REPL should be strings")) + (cl-pushnew (cons key repl) alist + :test (lambda (x y) + (let ((cx (car x)) (cy (car y))) + (or (and (stringp cx) (stringp cy) (string-equal cx cy)) + (and (symbolp cx) (symbolp cy) (eq cx cy)))))) alist) (defun which-key/add-key-based-replacements (key repl &rest more) ;; TODO: Make interactive - (setq which-key-key-based-description-replacement-alist - (which-key//add-key-based-replacements - which-key-key-based-description-replacement-alist key repl more))) + (while key + (setq which-key-key-based-description-replacement-alist + (which-key//add-key-based-replacements + which-key-key-based-description-replacement-alist key repl)) + (setq key (pop more) repl (pop more)))) (defun which-key/add-major-mode-key-based-replacements (mode key repl &rest more) ;; TODO: Make interactive (when (not (symbolp mode)) (error "MODE should be a symbol corresponding to a value of major-mode")) (let ((mode-alist (cdr (assq mode which-key-key-based-description-replacement-alist)))) - (setq mode-alist (which-key//add-key-based-replacements - mode-alist key repl more) - which-key-key-based-description-replacement-alist - (delq mode which-key-key-based-description-replacement-alist) + (while key + (setq mode-alist (which-key//add-key-based-replacements + mode-alist key repl)) + (setq key (pop more) repl (pop more))) + (setq which-key-key-based-description-replacement-alist + (assq-delete-all mode which-key-key-based-description-replacement-alist) which-key-key-based-description-replacement-alist - (push mode-alist + (push (cons mode mode-alist) which-key-key-based-description-replacement-alist)))) ;; Update commit beafeb59b577e3b17ec81780649f4374e5c3d02d Author: Justin Burkett Date: Thu Jul 9 12:33:36 2015 -0400 Another typo diff --git a/which-key.el b/which-key.el index bdbf9c70d4e..094f3324891 100644 --- a/which-key.el +++ b/which-key.el @@ -225,7 +225,7 @@ bottom." ;; TODO: Make interactive (when (not (symbolp mode)) (error "MODE should be a symbol corresponding to a value of major-mode")) - (let ((mode-alist (cdr (assq which-key-key-based-description-replacement-alist)))) + (let ((mode-alist (cdr (assq mode which-key-key-based-description-replacement-alist)))) (setq mode-alist (which-key//add-key-based-replacements mode-alist key repl more) which-key-key-based-description-replacement-alist commit 01ce08761e7c9b61b4f9ad7244312e8c18f52cf5 Author: Justin Burkett Date: Thu Jul 9 12:32:13 2015 -0400 Typo in add-major-mode-key-based-... diff --git a/which-key.el b/which-key.el index 66f940ccf1e..bdbf9c70d4e 100644 --- a/which-key.el +++ b/which-key.el @@ -225,7 +225,7 @@ bottom." ;; TODO: Make interactive (when (not (symbolp mode)) (error "MODE should be a symbol corresponding to a value of major-mode")) - (let ((mode-alist (car (assq which-key-key-based-description-replacement-alist)))) + (let ((mode-alist (cdr (assq which-key-key-based-description-replacement-alist)))) (setq mode-alist (which-key//add-key-based-replacements mode-alist key repl more) which-key-key-based-description-replacement-alist commit 5a7503a8bd9c8dbe5745f9f49cebb009850fe53e Merge: e6911fe0b21 a73d8b8fadc Author: Justin Burkett Date: Thu Jul 9 12:27:15 2015 -0400 Merge branch 'better-window-sizes' commit a73d8b8fadc505a7e3bc6d7373ad2a118d9a4b28 Author: Justin Burkett Date: Thu Jul 9 12:24:19 2015 -0400 remove mode-line diff --git a/which-key.el b/which-key.el index 8a810633085..e36fcc60454 100644 --- a/which-key.el +++ b/which-key.el @@ -161,7 +161,7 @@ Used when `which-key-popup-type' is frame.") (with-current-buffer which-key--buffer (setq-local cursor-type nil) (setq-local cursor-in-non-selected-windows nil) - (setq-local mode-line-format "")) + (setq-local mode-line-format nil)) (setq which-key--setup-p t)) ;;;###autoload commit ad8eb578cdd9544fc4914c85739ad7d46544fbda Merge: d0a9cc0c107 315eeca54db Author: Justin Burkett Date: Thu Jul 9 12:22:44 2015 -0400 Merge branch 'better-window-sizes' of https://github.com/bmag/emacs-which-key into better-window-sizes commit d0a9cc0c10773fe6c579ac4864f467a13742e550 Author: Justin Burkett Date: Thu Jul 9 11:12:19 2015 -0400 Change side-window params to percentages diff --git a/which-key.el b/which-key.el index aa4a2897605..ace968ac4bf 100644 --- a/which-key.el +++ b/which-key.el @@ -76,12 +76,12 @@ the feature off.") (defvar which-key-side-window-location 'right "Location of which-key popup when `which-key-popup-type' is side-window. Should be one of top, bottom, left or right.") -(defvar which-key-side-window-max-width 60 +(defvar 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.") -(defvar which-key-side-window-max-height 20 +(defvar 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 commit 315eeca54dbceeb240f7056ddc034a0c1b82f870 Author: Bar Magal Date: Thu Jul 9 18:56:36 2015 +0300 Use fit-window-to-buffer again diff --git a/which-key.el b/which-key.el index aa4a2897605..a95d2cef00a 100644 --- a/which-key.el +++ b/which-key.el @@ -237,7 +237,9 @@ the frame." (+ text-width (/ (frame-fringe-width) char-width) (/ (frame-scroll-bar-width) char-width) - (if (which-key/char-enlarged-p) 1 0)))) + (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. @@ -249,7 +251,9 @@ character width as the frame." (- total-width (/ (frame-fringe-width) char-width) (/ (frame-scroll-bar-width) char-width) - (if (which-key/char-enlarged-p) 1 0)))) + (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))))) @@ -315,12 +319,16 @@ need to start the closing timer." (defun which-key/show-buffer-minibuffer (act-popup-dim) nil) -(defun which-key/show-buffer-side-window (act-popup-dim) - (let* ((height (car act-popup-dim)) - (width (which-key/text-width-to-total (cdr act-popup-dim))) - (side which-key-side-window-location) - (alist (delq nil (list (when height (cons 'window-height height)) - (when width (cons 'window-width width)))))) +;; &rest params because `fit-buffer-to-window' has a different call signature +;; in different emacs versions +(defun which-key/fit-buffer-to-window-horizontally (&optional window &rest params) + (let ((fit-window-to-buffer-horizontally t)) + (apply #'fit-window-to-buffer window params))) + +(defun which-key/show-buffer-side-window (_act-popup-dim) + (let* ((side which-key-side-window-location) + (alist '((window-width . which-key/fit-buffer-to-window-horizontally) + (window-height . fit-window-to-buffer)))) ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' ;; were added in Emacs 24.3 commit d9a9bd5ae6172d6cc8a6f1bdf6d2608ad3c885b8 Author: Bar Magal Date: Thu Jul 9 17:27:11 2015 +0300 Allow percentages for side-window max sizes #19 diff --git a/which-key.el b/which-key.el index 8675aba6e72..aa4a2897605 100644 --- a/which-key.el +++ b/which-key.el @@ -78,10 +78,14 @@ the feature off.") side-window. Should be one of top, bottom, left or right.") (defvar which-key-side-window-max-width 60 "Maximum width of which-key popup when type is side-window and -location is left or right.") +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.") (defvar which-key-side-window-max-height 20 "Maximum height of which-key popup when type is side-window and -location is top or bottom.") +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.") (defvar which-key-frame-max-width 60 "Maximum width of which-key popup when type is frame.") (defvar which-key-frame-max-height 20 @@ -256,6 +260,26 @@ character width as the frame." (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)))))) + ;; Show/hide guide buffer (defun which-key/hide-popup () @@ -412,10 +436,11 @@ of the intended popup." ;; (window-height (minibuffer-window)) ;; (window-mode-line-height which-key--window)) ;; FIXME: change to something like (min which-*-height (calculate-max-height)) - which-key-side-window-max-height) + (which-key/height-or-percentage-to-height which-key-side-window-max-height)) ;; width (if (member which-key-side-window-location '(left right)) - (which-key/total-width-to-text which-key-side-window-max-width) + (which-key/total-width-to-text (which-key/width-or-percentage-to-width + which-key-side-window-max-width)) (window-width (frame-root-window))))) (defun which-key/frame-max-dimensions () commit e6911fe0b210506a9665242977fa803b5c8fc021 Author: Justin Burkett Date: Thu Jul 9 09:38:45 2015 -0400 Add functions for adding to replacement alists diff --git a/which-key.el b/which-key.el index 49f1f4f6b0b..5c3f4214c4a 100644 --- a/which-key.el +++ b/which-key.el @@ -160,6 +160,9 @@ Used when `which-key-popup-type' is frame.") (setq-local mode-line-format nil)) (setq which-key--setup-p t)) +;; Default configuration functions for use by users. Should be the "best" +;; configurations + ;;;###autoload (defun which-key/setup-side-window-right () "Apply suggested settings for side-window that opens on right." @@ -196,6 +199,37 @@ bottom." "Deactivate idle timer." (when which-key--open-timer (cancel-timer which-key--open-timer))) +;; Helper functions to modify replacement lists. + +(defun which-key//add-key-based-replacements (alist key repl &rest more) + (while key + (when (or (not (stringp key)) (not (stringp repl))) + (error "KEY and REPL should be strings")) + (cl-pushnew (cons key repl) alist + :test (lambda (x y) (string-equal (car x) (car y)))) + (setq key (pop more) + repl (pop more))) + alist) + +(defun which-key/add-key-based-replacements (key repl &rest more) + ;; TODO: Make interactive + (setq which-key-key-based-description-replacement-alist + (which-key//add-key-based-replacements + which-key-key-based-description-replacement-alist key repl more))) + +(defun which-key/add-major-mode-key-based-replacements (mode key repl &rest more) + ;; TODO: Make interactive + (when (not (symbolp mode)) + (error "MODE should be a symbol corresponding to a value of major-mode")) + (let ((mode-alist (car (assq which-key-key-based-description-replacement-alist)))) + (setq mode-alist (which-key//add-key-based-replacements + mode-alist key repl more) + which-key-key-based-description-replacement-alist + (delq mode which-key-key-based-description-replacement-alist) + which-key-key-based-description-replacement-alist + (push mode-alist + which-key-key-based-description-replacement-alist)))) + ;; Update (defun which-key/update () commit 688ba7ee95e9e07e4991e647184e95e8e43be829 Author: Bar Magal Date: Thu Jul 9 16:22:27 2015 +0300 Fix text vs. total window width handling #22 diff --git a/which-key.el b/which-key.el index 35147934208..8675aba6e72 100644 --- a/which-key.el +++ b/which-key.el @@ -220,6 +220,42 @@ Finally, show the buffer." ;; command finished maybe close the window ;; (which-key/hide-popup)))) +;; window-size utilities + +(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)))) + +(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)))) + +(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))))) + ;; Show/hide guide buffer (defun which-key/hide-popup () @@ -257,7 +293,7 @@ need to start the closing timer." (defun which-key/show-buffer-side-window (act-popup-dim) (let* ((height (car act-popup-dim)) - (width (cdr act-popup-dim)) + (width (which-key/text-width-to-total (cdr act-popup-dim))) (side which-key-side-window-location) (alist (delq nil (list (when height (cons 'window-height height)) (when width (cons 'window-width width)))))) @@ -277,11 +313,8 @@ need to start the closing timer." ;; (display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist)) ;; side defaults to bottom (if (get-buffer-window which-key--buffer) - (progn - (display-buffer-reuse-window which-key--buffer alist)) - (display-buffer-in-major-side-window which-key--buffer side 0 alist)) - (let ((fit-window-to-buffer-horizontally t)) - (fit-window-to-buffer (get-buffer-window which-key--buffer))))) + (display-buffer-reuse-window which-key--buffer alist) + (display-buffer-in-major-side-window which-key--buffer side 0 alist)))) (defun which-key/show-buffer-frame (act-popup-dim) (let* ((orig-window (selected-window)) @@ -382,8 +415,8 @@ of the intended popup." which-key-side-window-max-height) ;; width (if (member which-key-side-window-location '(left right)) - which-key-side-window-max-width - (frame-width)))) + (which-key/total-width-to-text which-key-side-window-max-width) + (window-width (frame-root-window))))) (defun which-key/frame-max-dimensions () (cons which-key-frame-max-height which-key-frame-max-width)) commit 69d6b46be7641938ce2c50e050b1271cababd3e4 Author: Justin Burkett Date: Thu Jul 9 08:22:56 2015 -0400 Remove mode-line and tweak max-height max-height for side-window could still be more precise, but this seems to work diff --git a/which-key.el b/which-key.el index 35147934208..49f1f4f6b0b 100644 --- a/which-key.el +++ b/which-key.el @@ -157,7 +157,7 @@ Used when `which-key-popup-type' is frame.") (with-current-buffer which-key--buffer (setq-local cursor-type nil) (setq-local cursor-in-non-selected-windows nil) - (setq-local mode-line-format "")) + (setq-local mode-line-format nil)) (setq which-key--setup-p t)) ;;;###autoload @@ -375,8 +375,7 @@ of the intended popup." (cons ;; height (if (member which-key-side-window-location '(left right)) - (- (frame-height) 1) ; 1 is for minibuffer - ;; (window-height (minibuffer-window)) + (- (frame-height) (window-text-height (minibuffer-window)) 1) ;; 1 is a kludge to make sure there is no overlap ;; (window-mode-line-height which-key--window)) ;; FIXME: change to something like (min which-*-height (calculate-max-height)) which-key-side-window-max-height) commit bd2daa7f1b750e8dc60a548a91c769c583508267 Author: Justin Burkett Date: Thu Jul 9 07:55:48 2015 -0400 Make user setup functions interactive and autoload diff --git a/which-key.el b/which-key.el index 6d08ad384f3..35147934208 100644 --- a/which-key.el +++ b/which-key.el @@ -160,21 +160,27 @@ Used when `which-key-popup-type' is frame.") (setq-local mode-line-format "")) (setq which-key--setup-p t)) +;;;###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-bottom () "Apply suggested settings for side-window that opens on bottom." + (interactive) (setq which-key-popup-type 'side-window which-key-side-window-location 'bottom which-key-show-prefix nil)) +;;;###autoload (defun which-key/setup-minibuffer () "Apply suggested settings for minibuffer." + (interactive) (setq which-key-popup-type 'minibuffer which-key-show-prefix 'left)) commit 7f96e4d86b623c71ddb9d01ebfa9a4a58524d659 Author: Justin Burkett Date: Thu Jul 9 07:44:36 2015 -0400 Fix #22 Check for keymap instead of not a symbol. diff --git a/which-key.el b/which-key.el index c3e06f9a796..6d08ad384f3 100644 --- a/which-key.el +++ b/which-key.el @@ -196,8 +196,10 @@ bottom." "Fill which-key--buffer with key descriptions and reformat. Finally, show the buffer." (let ((prefix-keys (this-single-command-keys))) +;; (when (> (length prefix-keys) 0) (message "key: %s" (key-description prefix-keys))) +;; (when (> (length prefix-keys) 0) (message "key binding: %s" (key-binding prefix-keys))) (when (and (> (length prefix-keys) 0) - (not (symbolp (key-binding prefix-keys)))) + (keymapp (key-binding prefix-keys))) (let* ((buf (current-buffer)) ;; get formatted key bindings (fmt-width-cons (which-key/get-formatted-key-bindings buf prefix-keys)) commit cddf125c36e60cacb9aa851bf93fe88bc901effc Author: Justin Burkett Date: Thu Jul 9 07:25:47 2015 -0400 Remove hidden-mode-line-mode diff --git a/which-key.el b/which-key.el index e248a255b26..c3e06f9a796 100644 --- a/which-key.el +++ b/which-key.el @@ -157,7 +157,7 @@ Used when `which-key-popup-type' is frame.") (with-current-buffer which-key--buffer (setq-local cursor-type nil) (setq-local cursor-in-non-selected-windows nil) - (hidden-mode-line-mode t)) + (setq-local mode-line-format "")) (setq which-key--setup-p t)) (defun which-key/setup-side-window-right () commit dfbefe4c827be081f4d82c62268c4a8745335a0c Author: Justin Burkett Date: Wed Jul 8 22:36:07 2015 -0400 Add minibuffer picture diff --git a/img/which-key-minibuffer.png b/img/which-key-minibuffer.png new file mode 100644 index 00000000000..586920aed44 Binary files /dev/null and b/img/which-key-minibuffer.png differ commit 6c40180271d5803abda1c2a73de75cbe714b5c7f Author: Justin Burkett Date: Wed Jul 8 22:28:25 2015 -0400 Delete which-key-minibuffer.PNG diff --git a/img/which-key-minibuffer.PNG b/img/which-key-minibuffer.PNG deleted file mode 100644 index 640f5378a07..00000000000 Binary files a/img/which-key-minibuffer.PNG and /dev/null differ commit 041bc9d2813867bfe72f2145ac4a074f91223263 Author: Justin Burkett Date: Wed Jul 8 22:25:00 2015 -0400 Add bottom section and picture to readme diff --git a/README.org b/README.org index 4113a1ed108..f785ceb5474 100644 --- a/README.org +++ b/README.org @@ -50,6 +50,16 @@ Popup side window on right. For defaults use [[./img/which-key-right.png]] +** Side Window Bottom Option +Popup side window on bottom. For defaults use + +#+BEGIN_SRC emacs-lisp +(which-key/setup-side-window-bottom) +#+END_SRC + +[[./img/which-key-bottom.png]] + + * Status/Goals ** Stability - It's very much a work in progress, so expect weird things to happen from time commit 25d29cddaf53230be326722f128f1cad83cf9d0c Author: Justin Burkett Date: Wed Jul 8 22:20:03 2015 -0400 Add minibuffer picture diff --git a/img/which-key-minibuffer.PNG b/img/which-key-minibuffer.PNG new file mode 100644 index 00000000000..640f5378a07 Binary files /dev/null and b/img/which-key-minibuffer.PNG differ commit 0e564fc2f598fa5bf866af9b85e080e4c5a97d3a Author: Justin Burkett Date: Wed Jul 8 22:18:02 2015 -0400 Add config setup functions and more Fix a problem where the frame-height was not accouting for the minibuffer. Also, set the buffer to hidden-mode-line-mode to hide the mode-line for now (#16). diff --git a/which-key.el b/which-key.el index 46961a014f4..e248a255b26 100644 --- a/which-key.el +++ b/which-key.el @@ -156,9 +156,28 @@ Used when `which-key-popup-type' is frame.") (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer (setq-local cursor-type nil) - (setq-local cursor-in-non-selected-windows nil)) + (setq-local cursor-in-non-selected-windows nil) + (hidden-mode-line-mode t)) (setq which-key--setup-p t)) +(defun which-key/setup-side-window-right () + "Apply suggested settings for side-window that opens on right." + (setq which-key-popup-type 'side-window + which-key-side-window-location 'right + which-key-show-prefix 'top)) + +(defun which-key/setup-side-window-bottom () + "Apply suggested settings for side-window that opens on +bottom." + (setq which-key-popup-type 'side-window + which-key-side-window-location 'bottom + which-key-show-prefix nil)) + +(defun which-key/setup-minibuffer () + "Apply suggested settings for minibuffer." + (setq which-key-popup-type 'minibuffer + which-key-show-prefix 'left)) + ;; Timers (defun which-key/start-open-timer () @@ -250,7 +269,8 @@ need to start the closing timer." ;; (display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist)) ;; side defaults to bottom (if (get-buffer-window which-key--buffer) - (display-buffer-reuse-window which-key--buffer alist) + (progn + (display-buffer-reuse-window which-key--buffer alist)) (display-buffer-in-major-side-window which-key--buffer side 0 alist)) (let ((fit-window-to-buffer-horizontally t)) (fit-window-to-buffer (get-buffer-window which-key--buffer))))) @@ -347,7 +367,9 @@ of the intended popup." (cons ;; height (if (member which-key-side-window-location '(left right)) - (frame-height) + (- (frame-height) 1) ; 1 is for minibuffer + ;; (window-height (minibuffer-window)) + ;; (window-mode-line-height which-key--window)) ;; FIXME: change to something like (min which-*-height (calculate-max-height)) which-key-side-window-max-height) ;; width @@ -383,16 +405,19 @@ N-COLUMNS is the number of text columns to use and MAX-LINES is the maximum number of lines availabel in the target buffer." (let* ((n-keys (length keys)) (n-lines (min (ceiling (/ (float n-keys) n-columns)) max-lines)) - (line-padding (when (eq which-key-show-prefix 'left) (s-repeat prefix-len " "))) + (line-padding (when (eq which-key-show-prefix 'left) + (s-repeat prefix-len " "))) lines) (dotimes (i n-lines) (setq lines - (push - (cl-subseq keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) + (push (cl-subseq keys (* i n-columns) + (min n-keys (* (1+ i) n-columns))) lines))) - (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) (concat "\n" line-padding)))) + (mapconcat (lambda (x) (apply 'concat x)) + (reverse lines) (concat "\n" line-padding)))) -(defun which-key/populate-buffer (prefix-keys formatted-keys column-width sel-win-width) +(defun which-key/populate-buffer (prefix-keys formatted-keys + column-width sel-win-width) "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." (let* ((vertical-mode (member which-key-side-window-location '(left right))) (prefix-w-face (which-key/propertize-key prefix-keys)) commit e63acf1e5d16cce9be3f9e25e82056e1797a8ff3 Author: Justin Burkett Date: Wed Jul 8 22:16:21 2015 -0400 Update readme diff --git a/README.org b/README.org index 93cbaad6010..4113a1ed108 100644 --- a/README.org +++ b/README.org @@ -1,16 +1,71 @@ Rewrite of guide-key-mode for emacs. -Here's a recent picture showing what it does: +* Install +Add which-key.el to your load-path and require. Some thing like -[[./img/which-key-bottom.png]] +#+BEGIN_SRC emacs-lisp +(add-to-list 'load-path "path/to/which-key.el") +(require 'which-key) +(which-key-mode) +#+END_SRC -* Status -It is somewhat stable for me at the moment, but expect to see potentially weird -behavior (then to report it to me!). -** Completed +There are 3 choices of default configs for you to try (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 (which are configurable but not well documented at the moment). + +By default which-key makes substitutions for text all with the aim of saving +space. The most noticeable are the "special keys" like SPC, TAB, RET, etc. This +can be turned off, but the default is to truncate these keys to one character +and display them using inverse-video (flips foreground and background colors). +You can see the effect in the screenshots. + +There are other substitution abilities included, which are quite flexible +(ability to use regexp for example). This makes which-key very customizable. +This functionality is targeting [[https://github.com/syl20bnr/spacemacs][spacemacs]]. + +** Minibuffer Option +Take over the minibuffer. Setup by default, but you can also 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. + +** Side Window Right Option +Popup side window on right. For defaults use + +#+BEGIN_SRC emacs-lisp +(which-key/setup-side-window-right) +#+END_SRC + +[[./img/which-key-right.png]] + + +* Status/Goals +** Stability +- It's very much a work in progress, so expect weird things to happen from time + to time. That being said, the default configuration works well for me. +** Completed Goals 1. Use idle timers to trigger window popup instead of guide-key's constant polling. -2. Add support for replacement lists to modify key descriptions on the fly. -** Ongoing/Planned -1. Explore alternatives to popwin like window-pupose and using display-buffer - directly +2. Remove popwin as a "hard" dependency, prefering built-in display commands + where possible. +3. Add support for replacement lists to modify key descriptions on the fly. + Currently you can replace in the key or description field using regexp, and + using a key sequence (like "C-x 1") to fully replace the description (the + latter can target major modes, too). +** Incomplete and Planned +1. Come up with creative ways to fit more keys in buffer while still maintaining + nice alignment and formatting. Such as + 1. Automatic text scaling + 2. Paging functionality + diff --git a/img/which-key-bottom.png b/img/which-key-bottom.png index f0969813001..9ed2bf1090a 100644 Binary files a/img/which-key-bottom.png and b/img/which-key-bottom.png differ diff --git a/img/which-key-right.png b/img/which-key-right.png index a207d5a82e5..f01a40bc453 100644 Binary files a/img/which-key-right.png and b/img/which-key-right.png differ commit 82f252fdad74c0bc51c5209105d6d0ef22f01cc8 Author: Justin Burkett Date: Wed Jul 8 20:39:27 2015 -0400 Possible fix for #18 diff --git a/which-key.el b/which-key.el index 1d93066c9ed..46961a014f4 100644 --- a/which-key.el +++ b/which-key.el @@ -177,7 +177,8 @@ Used when `which-key-popup-type' is frame.") "Fill which-key--buffer with key descriptions and reformat. Finally, show the buffer." (let ((prefix-keys (this-single-command-keys))) - (when (> (length prefix-keys) 0) + (when (and (> (length prefix-keys) 0) + (not (symbolp (key-binding prefix-keys)))) (let* ((buf (current-buffer)) ;; get formatted key bindings (fmt-width-cons (which-key/get-formatted-key-bindings buf prefix-keys)) commit a7c7862e47a88382bcf97bd1e7f04de8b28aad2f Author: Justin Burkett Date: Wed Jul 8 16:08:03 2015 -0400 Fix #21 diff --git a/which-key.el b/which-key.el index b8be10f1a23..1d93066c9ed 100644 --- a/which-key.el +++ b/which-key.el @@ -393,7 +393,8 @@ the maximum number of lines availabel in the target buffer." (defun which-key/populate-buffer (prefix-keys formatted-keys column-width sel-win-width) "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." - (let* ((prefix-w-face (which-key/propertize-key prefix-keys)) + (let* ((vertical-mode (member which-key-side-window-location '(left right))) + (prefix-w-face (which-key/propertize-key prefix-keys)) (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) (prefix-string (when which-key-show-prefix (if (eq which-key-show-prefix 'left) @@ -406,8 +407,11 @@ the maximum number of lines availabel in the target buffer." (if (eq which-key-show-prefix 'left) (- (cdr max-dims) prefix-len) (cdr max-dims)) 0)) - ;; the 3 leaves room for the ... possibly on the first page (remove for now) (n-columns (/ max-width-for-columns column-width)) ;; integer division + (n-columns (if vertical-mode + ;; use up vertical space first if possible + (min n-columns (ceiling (/ (float n-keys) max-height))) + n-columns)) (act-width (+ (* n-columns column-width) (if (eq which-key-show-prefix 'left) prefix-len 0))) ;; (avl-lines/page (which-key/available-lines)) commit 3c5f1ba686a59a0490c8f491f3b9b020fa00ac98 Author: Justin Burkett Date: Wed Jul 8 15:35:53 2015 -0400 Fix act-width in populate-buffer diff --git a/which-key.el b/which-key.el index d56f9f2ce1c..b8be10f1a23 100644 --- a/which-key.el +++ b/which-key.el @@ -402,19 +402,20 @@ the maximum number of lines availabel in the target buffer." (n-keys (length formatted-keys)) (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-height (when (car max-dims) (car max-dims))) - (max-width (if (cdr max-dims) - (if (eq which-key-show-prefix 'left) - (- (cdr max-dims) prefix-len) - (cdr max-dims)) 0)) + (max-width-for-columns (if (cdr max-dims) + (if (eq which-key-show-prefix 'left) + (- (cdr max-dims) prefix-len) + (cdr max-dims)) 0)) ;; the 3 leaves room for the ... possibly on the first page (remove for now) - (n-columns (/ max-width column-width)) ;; integer division - (act-width (* n-columns column-width)) + (n-columns (/ max-width-for-columns column-width)) ;; integer division + (act-width (+ (* n-columns column-width) + (if (eq which-key-show-prefix 'left) prefix-len 0))) ;; (avl-lines/page (which-key/available-lines)) (max-keys/page (when max-height (* n-columns max-height))) (n-pages (if (> max-keys/page 0) (ceiling (/ (float n-keys) max-keys/page)) 1)) pages act-height first-page) - (if (and (> n-keys 0) (> act-width 0)) + (if (and (> n-keys 0) (> n-columns 0)) (progn (dotimes (p n-pages) (setq pages @@ -436,7 +437,7 @@ the maximum number of lines availabel in the target buffer." (cons act-height act-width)) (if (<= n-keys 0) (message "Can't display which-key buffer: There are no keys to show.") - (message "Can't display which-key buffer: A minimum width of %s chars is required, but your settings only allow for %s chars." column-width max-width) + (message "Can't display which-key buffer: A minimum width of %s chars is required, but your settings only allow for %s chars." column-width max-width-for-columns) ) (cons 0 act-width)))) commit 3ce0c3e56f59ab0c0e92e99425b89bd7b01a6a50 Author: Justin Burkett Date: Wed Jul 8 13:55:53 2015 -0400 Rework key-based replacement Previous implementation didn't work for multiple major-mode bindings diff --git a/which-key.el b/which-key.el index c63ec294ed4..d56f9f2ce1c 100644 --- a/which-key.el +++ b/which-key.el @@ -49,15 +49,19 @@ for replacing descriptions. The second one removes \"namespace/\" from \"namespace/function\". This is a convention for naming functions but not a rule, so remove this replacement if it becomes problematic.") -(defvar which-key-key-based-description-replacement-alist - '(("SPC f f" "find files")) - "Like `which-key-key-replacement-alist', but the first element -of each list matches on the key sequence. When there is a match -the description of that key sequence is overwritten with the -second element of the list. An optional third element of each -list may specify a value for `major-mode'. In this case the -replacement will only apply in case that major-mode is -active.") +(defvar which-key-key-based-description-replacement-alist '() + "Each item in the list is a cons cell. The car of each cons +cell is either a string like \"C-c\", in which case it's +interpreted as a key sequence or a value of `major-mode'. Here +are two examples: + +(\"SPC f f\" . \"find files\") +(emacs-lisp-mode . ((\"SPC m d\" . \"debug\"))) + +In the first case the description of the key sequence \"SPC f f\" +is overwritten with \"find files\". The second case works the +same way using the alist matched when `major-mode' is +emacs-lisp-mode.") (defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") "These keys will automatically be truncated to one character and have `which-key-special-key-face' applied to them.") @@ -436,12 +440,13 @@ the maximum number of lines availabel in the target buffer." ) (cons 0 act-width)))) -(defun which-key/maybe-replace-key-based (string keys repl-alist) - (let ((ret-val (assoc-string keys repl-alist))) - (cond ((and ret-val (eq major-mode (nth 2 ret-val))) - (nth 1 ret-val)) - ((and ret-val (not (nth 2 ret-val))) - (nth 1 ret-val)) +(defun which-key/maybe-replace-key-based (string keys) + (let* ((alist which-key-key-based-description-replacement-alist) + (str-res (assoc-string keys alist)) + (mode-alist (assq major-mode alist)) + (mode-res (when mode-alist (assoc-string keys mode-alist)))) + (cond (mode-res (cdr mode-res)) + (str-res (cdr str-res)) (t string)))) (defun which-key/maybe-replace (string repl-alist &optional literal) @@ -494,8 +499,7 @@ key and description replacement alists." (keys (concat prefix-keys " " key)) (key (which-key/maybe-replace key which-key-key-replacement-alist)) (desc (which-key/maybe-replace desc which-key-description-replacement-alist)) - (desc (which-key/maybe-replace-key-based desc keys - which-key-key-based-description-replacement-alist)) + (desc (which-key/maybe-replace-key-based desc keys)) (group (string-match-p "^group:" desc)) (desc (if group (substring desc 6) desc)) (prefix (string-match-p "^Prefix" desc)) commit 0fd81d309e44980f626d5cd40e003606f3369265 Author: Justin Burkett Date: Wed Jul 8 13:32:27 2015 -0400 Fix replace-match and rewrite propertize-key diff --git a/which-key.el b/which-key.el index 921301ea0e7..c63ec294ed4 100644 --- a/which-key.el +++ b/which-key.el @@ -399,9 +399,9 @@ the maximum number of lines availabel in the target buffer." (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-height (when (car max-dims) (car max-dims))) (max-width (if (cdr max-dims) - (if (eq which-key-show-prefix 'left) - (- (cdr max-dims) prefix-len) - (cdr max-dims)) 0)) + (if (eq which-key-show-prefix 'left) + (- (cdr max-dims) prefix-len) + (cdr max-dims)) 0)) ;; the 3 leaves room for the ... possibly on the first page (remove for now) (n-columns (/ max-width column-width)) ;; integer division (act-width (* n-columns column-width)) @@ -452,23 +452,22 @@ non-nil regexp is used in the replacements." (save-match-data (let ((new-string string)) (dolist (repl repl-alist) - (when (string-match (nth 0 repl) new-string) + (when (string-match (car repl) new-string) (setq new-string - (replace-match (nth 1 repl) t literal new-string)))) + (replace-match (cdr repl) t literal new-string)))) new-string))) (defun which-key/propertize-key (key) - (let ((key-w-face (propertize key 'face 'which-key-key-face))) - (dolist (special-key which-key-special-keys) - (when (string-match special-key key) - (let ((beg (match-beginning 0)) (end (match-end 0))) - (setq key-w-face - (concat (substring key-w-face 0 beg) - (propertize (substring key-w-face beg (1+ beg)) - 'face 'which-key-special-key-face) - (when (< end (length key-w-face)) - (substring key-w-face end (length key-w-face)))))))) - key-w-face)) + (let ((key-w-face (propertize key 'face 'which-key-key-face)) + (regexp (concat "\\(" (mapconcat 'identity which-key-special-keys "\\|") "\\)"))) + (save-match-data + (if (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 (length key-w-face)))) + key-w-face)))) (defsubst which-key/truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." commit a27658524d328486be7bb67659f49d37028b7458 Author: Justin Burkett Date: Wed Jul 8 13:20:27 2015 -0400 Break out key-based replacement function. Seems simpler to use `assoc-string` in this case. diff --git a/which-key.el b/which-key.el index a908c7c6ca7..921301ea0e7 100644 --- a/which-key.el +++ b/which-key.el @@ -38,21 +38,26 @@ popup.") (defvar which-key-separator "→" "Separator to use between key and description.") (defvar which-key-key-replacement-alist - '(("<\\(\\(C-\\|M-\\)*.+\\)>" "\\1") ("left" "←") ("right" "→")) - "The strings in the first element of each list are replaced -with the strings in the second for each key. Elisp regexp can be -used as in the first example. The third element of each list may -specify a value for `major-mode'. In this case the replacement -will only apply in case that major-mode is active.") + '(("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") ("left" . "←") ("right" . "→")) + "The strings in the car of each cons are replaced with the +strings in the cdr for each key. Elisp regexp can be used as +in the first example.") (defvar which-key-description-replacement-alist - '(("Prefix Command" "prefix") (".+/\\(.+\\)" "\\1")) + '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1")) "See `which-key-key-replacement-alist'. This is a list of lists for replacing descriptions. The second one removes \"namespace/\" from \"namespace/function\". This is a convention for naming functions but not a rule, so remove this replacement if it becomes problematic.") (defvar which-key-key-based-description-replacement-alist - '(("SPC f f" "find files"))) + '(("SPC f f" "find files")) + "Like `which-key-key-replacement-alist', but the first element +of each list matches on the key sequence. When there is a match +the description of that key sequence is overwritten with the +second element of the list. An optional third element of each +list may specify a value for `major-mode'. In this case the +replacement will only apply in case that major-mode is +active.") (defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") "These keys will automatically be truncated to one character and have `which-key-special-key-face' applied to them.") @@ -431,29 +436,26 @@ the maximum number of lines availabel in the target buffer." ) (cons 0 act-width)))) -(defun which-key/maybe-replace (string repl-alist &optional keys literal) +(defun which-key/maybe-replace-key-based (string keys repl-alist) + (let ((ret-val (assoc-string keys repl-alist))) + (cond ((and ret-val (eq major-mode (nth 2 ret-val))) + (nth 1 ret-val)) + ((and ret-val (not (nth 2 ret-val))) + (nth 1 ret-val)) + (t string)))) + +(defun which-key/maybe-replace (string repl-alist &optional literal) "Perform replacements on STRING. REPL-ALIST is an alist where the car of each element is the text to replace and the cdr is the replacement text. Unless LITERAL is non-nil regexp is used in the replacements." - (let ((new-string string)) - (if keys ;; use key-based replacement - (dolist (repl repl-alist) - (if (nth 2 repl) ;; major-mode option - (when (and (eq major-mode (nth 2 repl)) - (string-equal (nth 0 repl) keys)) - (setq new-string (nth 1 repl))) - (when (string-equal (nth 0 repl) keys) - (setq new-string (nth 1 repl))))) + (save-match-data + (let ((new-string string)) (dolist (repl repl-alist) - (if (nth 2 repl) ;; major-mode option - (when (and (eq major-mode (nth 2 repl)) - (string-match (nth 0 repl) new-string)) - (replace-match (nth 1 repl) t literal new-string)) - (when (string-match (nth 0 repl) new-string) - (setq new-string - (replace-match (nth 1 repl) t literal new-string)))))) - new-string)) + (when (string-match (nth 0 repl) new-string) + (setq new-string + (replace-match (nth 1 repl) t literal new-string)))) + new-string))) (defun which-key/propertize-key (key) (let ((key-w-face (propertize key 'face 'which-key-key-face))) @@ -493,8 +495,8 @@ key and description replacement alists." (keys (concat prefix-keys " " key)) (key (which-key/maybe-replace key which-key-key-replacement-alist)) (desc (which-key/maybe-replace desc which-key-description-replacement-alist)) - (desc (which-key/maybe-replace desc - which-key-key-based-description-replacement-alist keys)) + (desc (which-key/maybe-replace-key-based desc keys + which-key-key-based-description-replacement-alist)) (group (string-match-p "^group:" desc)) (desc (if group (substring desc 6) desc)) (prefix (string-match-p "^Prefix" desc)) commit 91916c129e7f1a6045fa5766d680f1cca39d1ade Author: Justin Burkett Date: Wed Jul 8 11:41:10 2015 -0400 Fixes #19 Kind of a hack, but seems a lot easier than trying to get an exact calculation of the width diff --git a/which-key.el b/which-key.el index 252aa2bda75..a908c7c6ca7 100644 --- a/which-key.el +++ b/which-key.el @@ -241,7 +241,9 @@ need to start the closing timer." ;; side defaults to bottom (if (get-buffer-window which-key--buffer) (display-buffer-reuse-window which-key--buffer alist) - (display-buffer-in-major-side-window which-key--buffer side 0 alist)))) + (display-buffer-in-major-side-window which-key--buffer side 0 alist)) + (let ((fit-window-to-buffer-horizontally t)) + (fit-window-to-buffer (get-buffer-window which-key--buffer))))) (defun which-key/show-buffer-frame (act-popup-dim) (let* ((orig-window (selected-window)) commit 52574e5e94e8d1381a7e5572fb96d149b688be48 Author: Justin Burkett Date: Wed Jul 8 11:35:40 2015 -0400 Remove hide-popup call from update function Doesn't seem to be needed anymore after adding hide-popup to the pre-command-hook. diff --git a/which-key.el b/which-key.el index ce539253a7d..252aa2bda75 100644 --- a/which-key.el +++ b/which-key.el @@ -168,21 +168,20 @@ Used when `which-key-popup-type' is frame.") "Fill which-key--buffer with key descriptions and reformat. Finally, show the buffer." (let ((prefix-keys (this-single-command-keys))) - (if (> (length prefix-keys) 0) - (progn - (let* ((buf (current-buffer)) - ;; get formatted key bindings - (fmt-width-cons (which-key/get-formatted-key-bindings buf prefix-keys)) - (formatted-keys (car fmt-width-cons)) - (column-width (cdr fmt-width-cons)) - ;; populate target buffer - (popup-act-dim - (which-key/populate-buffer (key-description prefix-keys) - formatted-keys column-width (window-width)))) - ;; show buffer - (which-key/show-popup popup-act-dim))) - ;; command finished maybe close the window - (which-key/hide-popup)))) + (when (> (length prefix-keys) 0) + (let* ((buf (current-buffer)) + ;; get formatted key bindings + (fmt-width-cons (which-key/get-formatted-key-bindings buf prefix-keys)) + (formatted-keys (car fmt-width-cons)) + (column-width (cdr fmt-width-cons)) + ;; populate target buffer + (popup-act-dim + (which-key/populate-buffer (key-description prefix-keys) + formatted-keys column-width (window-width)))) + ;; show buffer + (which-key/show-popup popup-act-dim))))) +;; command finished maybe close the window +;; (which-key/hide-popup)))) ;; Show/hide guide buffer commit 68e5f8155f62b7c6cd12531002ea618a093166e3 Author: Justin Burkett Date: Wed Jul 8 10:43:50 2015 -0400 Fix bug in format-matches diff --git a/which-key.el b/which-key.el index 86a633e08f6..ce539253a7d 100644 --- a/which-key.el +++ b/which-key.el @@ -476,10 +476,8 @@ non-nil regexp is used in the replacements." (defun which-key/format-matches (unformatted prefix-keys) "Turn each key-desc-cons in UNFORMATTED into formatted strings (including text properties), and pad with spaces so that -all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the -longest key and description in the buffer, respectively. -Replacements are performed using the key and description -replacement alists." +all are a uniform length. Replacements are performed using the +key and description replacement alists." (let ((max-key-width 0) (max-desc-width 0) (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face)) @@ -489,14 +487,13 @@ replacement alists." (setq after-replacements (mapcar (lambda (key-desc-cons) - (let* ((keys (concat prefix-keys " " (car key-desc-cons))) - (key (which-key/maybe-replace - (car key-desc-cons) which-key-key-replacement-alist)) - (desc (which-key/maybe-replace - (cdr key-desc-cons) which-key-description-replacement-alist)) - (desc (which-key/maybe-replace - (cdr key-desc-cons) which-key-key-based-description-replacement-alist - keys)) + (let* ((key (car key-desc-cons)) + (desc (cdr key-desc-cons)) + (keys (concat prefix-keys " " key)) + (key (which-key/maybe-replace key which-key-key-replacement-alist)) + (desc (which-key/maybe-replace desc which-key-description-replacement-alist)) + (desc (which-key/maybe-replace desc + which-key-key-based-description-replacement-alist keys)) (group (string-match-p "^group:" desc)) (desc (if group (substring desc 6) desc)) (prefix (string-match-p "^Prefix" desc)) commit fe5b1ee62e14bcc1e0f9719916463fec7cfb2dae Author: Justin Burkett Date: Wed Jul 8 10:36:57 2015 -0400 Add option to specify major-mode in replacements Note all replacements need to be proper lists instead of cons cells now to add the option to check the third argument. If the third argument is missing it defaults to replacing in all major modes diff --git a/which-key.el b/which-key.el index 3af32b891c8..86a633e08f6 100644 --- a/which-key.el +++ b/which-key.el @@ -38,20 +38,21 @@ popup.") (defvar which-key-separator "→" "Separator to use between key and description.") (defvar which-key-key-replacement-alist - '(("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") ("\\(left\\)" ."←") - ("\\(right\\)" . "→")) - "The strings in the car of each cons cell are replaced with the -strings in the cdr for each key.") + '(("<\\(\\(C-\\|M-\\)*.+\\)>" "\\1") ("left" "←") ("right" "→")) + "The strings in the first element of each list are replaced +with the strings in the second for each key. Elisp regexp can be +used as in the first example. The third element of each list may +specify a value for `major-mode'. In this case the replacement +will only apply in case that major-mode is active.") (defvar which-key-description-replacement-alist - '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1")) - "See `which-key-key-replacement-alist'. This is a list of cons -cells for replacing descriptions. The second one removes -\"namespace/\" from \"namespace/function\". This is a convention -for naming functions but not a rule, so remove this replacement -if it becomes problematic.") + '(("Prefix Command" "prefix") (".+/\\(.+\\)" "\\1")) + "See `which-key-key-replacement-alist'. This is a list of lists +for replacing descriptions. The second one removes \"namespace/\" +from \"namespace/function\". This is a convention for naming +functions but not a rule, so remove this replacement if it +becomes problematic.") (defvar which-key-key-based-description-replacement-alist - '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1") - ("SPC f f" "find files" t))) + '(("SPC f f" "find files"))) (defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") "These keys will automatically be truncated to one character and have `which-key-special-key-face' applied to them.") @@ -362,11 +363,8 @@ of the intended popup." (setq key-match (match-string 1) desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted - :test (lambda (x y) (string-equal (car x) (car y))))) - (setq format-res (which-key/format-matches unformatted (key-description key)) - formatted (car format-res) - column-width (cdr format-res))) - (cons formatted column-width))) + :test (lambda (x y) (string-equal (car x) (car y)))))) + (which-key/format-matches unformatted (key-description key)))) (defun which-key/create-page (prefix-len max-lines n-columns keys) "Format KEYS into string representing a single page of text. @@ -438,15 +436,23 @@ REPL-ALIST is an alist where the car of each element is the text to replace and the cdr is the replacement text. Unless LITERAL is non-nil regexp is used in the replacements." (let ((new-string string)) - (if keys + (if keys ;; use key-based replacement (dolist (repl repl-alist) - (when (and (string-equal (nth 0 repl) keys)) - (setq new-string (nth 1 repl)))) - (dolist (repl repl-alist) - (when (string-match (car repl) new-string) - (setq new-string - (replace-match (cdr repl) t literal new-string))))) - new-string)) + (if (nth 2 repl) ;; major-mode option + (when (and (eq major-mode (nth 2 repl)) + (string-equal (nth 0 repl) keys)) + (setq new-string (nth 1 repl))) + (when (string-equal (nth 0 repl) keys) + (setq new-string (nth 1 repl))))) + (dolist (repl repl-alist) + (if (nth 2 repl) ;; major-mode option + (when (and (eq major-mode (nth 2 repl)) + (string-match (nth 0 repl) new-string)) + (replace-match (nth 1 repl) t literal new-string)) + (when (string-match (nth 0 repl) new-string) + (setq new-string + (replace-match (nth 1 repl) t literal new-string)))))) + new-string)) (defun which-key/propertize-key (key) (let ((key-w-face (propertize key 'face 'which-key-key-face))) commit e5279fb8bd0d5fa61b6c376996081b84723e2064 Author: Justin Burkett Date: Wed Jul 8 08:52:28 2015 -0400 Revert unintended change to act-height calc diff --git a/which-key.el b/which-key.el index f86248f1f0b..3af32b891c8 100644 --- a/which-key.el +++ b/which-key.el @@ -417,7 +417,7 @@ the maximum number of lines availabel in the target buffer." ;; not doing anything with other pages for now (setq pages (reverse pages) first-page (concat prefix-string (car pages)) - act-height (s-count-matches "\n" first-page)) + act-height (1+ (s-count-matches "\n" first-page))) ;; (when (> (length pages) 1) (setq first-page (concat first-page "..."))) (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" first-page)) commit 721c015ba909c319eba52c831f45b953b441dbe8 Author: Justin Burkett Date: Wed Jul 8 08:29:16 2015 -0400 Fix #17 errors when not enough room is available. Also gives more control over whether and where to show prefix keys. When the buffer is vertical showing in first line seems to make more sense. diff --git a/which-key.el b/which-key.el index 58a674f546f..f86248f1f0b 100644 --- a/which-key.el +++ b/which-key.el @@ -57,6 +57,10 @@ if it becomes problematic.") and have `which-key-special-key-face' applied to them.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") +(defvar which-key-show-prefix 'left + "Whether to and where to display the current prfix sequence. +Possible choices are left (the default), top and nil. Nil turns +the feature off.") (defvar which-key-popup-type 'minibuffer "Supported types are minibuffer, side-window and frame.") (defvar which-key-side-window-location 'right @@ -205,10 +209,11 @@ Finally, show the buffer." 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." - (cl-case which-key-popup-type - (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)))) + (when (and (> (car act-popup-dim) 0) (> (cdr act-popup-dim) 0)) + (cl-case which-key-popup-type + (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))))) (defun which-key/show-buffer-minibuffer (act-popup-dim) nil) @@ -369,7 +374,7 @@ N-COLUMNS is the number of text columns to use and MAX-LINES is the maximum number of lines availabel in the target buffer." (let* ((n-keys (length keys)) (n-lines (min (ceiling (/ (float n-keys) n-columns)) max-lines)) - (line-padding (s-repeat prefix-len " ")) + (line-padding (when (eq which-key-show-prefix 'left) (s-repeat prefix-len " "))) lines) (dotimes (i n-lines) (setq lines @@ -382,37 +387,50 @@ the maximum number of lines availabel in the target buffer." "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." (let* ((prefix-w-face (which-key/propertize-key prefix-keys)) (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) + (prefix-string (when which-key-show-prefix + (if (eq which-key-show-prefix 'left) + (concat prefix-w-face " ") + (concat prefix-w-face "-\n")))) (n-keys (length formatted-keys)) (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-height (when (car max-dims) (car max-dims))) - (max-width (when (cdr max-dims) (cdr max-dims))) - ;; the 3 leaves room for the ... possibly on the first page - (n-columns (/ (- max-width prefix-len 3) column-width)) ;; integer division + (max-width (if (cdr max-dims) + (if (eq which-key-show-prefix 'left) + (- (cdr max-dims) prefix-len) + (cdr max-dims)) 0)) + ;; the 3 leaves room for the ... possibly on the first page (remove for now) + (n-columns (/ max-width column-width)) ;; integer division (act-width (* n-columns column-width)) ;; (avl-lines/page (which-key/available-lines)) (max-keys/page (when max-height (* n-columns max-height))) - (n-pages (if max-keys/page + (n-pages (if (> max-keys/page 0) (ceiling (/ (float n-keys) max-keys/page)) 1)) pages act-height first-page) - (when (and (> n-keys 0) (> n-columns 0)) - (dotimes (p n-pages) - (setq pages - (push (which-key/create-page - prefix-len max-height n-columns - (cl-subseq formatted-keys (* p max-keys/page) - (min (* (1+ p) max-keys/page) n-keys))) pages))) - ;; not doing anything with other pages for now - (setq pages (reverse pages) - act-height (1+ (s-count-matches "\n" (car pages)))) - (setq first-page (concat prefix-w-face " " (car pages))) - (when (> (length pages) 1) (setq first-page (concat first-page "..."))) - (if (eq which-key-popup-type 'minibuffer) - (let (message-log-max) (message "%s" first-page)) - (with-current-buffer which-key--buffer - (erase-buffer) - (insert first-page) - (goto-char (point-min))))) - (cons act-height act-width))) + (if (and (> n-keys 0) (> act-width 0)) + (progn + (dotimes (p n-pages) + (setq pages + (push (which-key/create-page + prefix-len max-height n-columns + (cl-subseq formatted-keys (* p max-keys/page) + (min (* (1+ p) max-keys/page) n-keys))) pages))) + ;; not doing anything with other pages for now + (setq pages (reverse pages) + first-page (concat prefix-string (car pages)) + act-height (s-count-matches "\n" first-page)) + ;; (when (> (length pages) 1) (setq first-page (concat first-page "..."))) + (if (eq which-key-popup-type 'minibuffer) + (let (message-log-max) (message "%s" first-page)) + (with-current-buffer which-key--buffer + (erase-buffer) + (insert first-page) + (goto-char (point-min)))) + (cons act-height act-width)) + (if (<= n-keys 0) + (message "Can't display which-key buffer: There are no keys to show.") + (message "Can't display which-key buffer: A minimum width of %s chars is required, but your settings only allow for %s chars." column-width max-width) + ) + (cons 0 act-width)))) (defun which-key/maybe-replace (string repl-alist &optional keys literal) "Perform replacements on STRING. commit bafd48048e92ef8987b9804d214e6c457179f433 Author: Justin Burkett Date: Wed Jul 8 07:40:17 2015 -0400 Add :group to faces diff --git a/which-key.el b/which-key.el index e872f08a978..58a674f546f 100644 --- a/which-key.el +++ b/which-key.el @@ -76,19 +76,24 @@ location is top or bottom.") ;; Faces (defface which-key-key-face '((t . (:inherit font-lock-constant-face))) - "Face for which-key keys") + "Face for which-key keys" + :group 'which-key) (defface which-key-separator-face '((t . (:inherit font-lock-comment-face))) - "Face for the separator (default separator is an arrow)") + "Face for the separator (default separator is an arrow)" + :group 'which-key) (defface which-key-command-description-face '((t . (:inherit font-lock-function-name-face))) - "Face for the key description when it is a command") + "Face for the key description when it is a command" + :group 'which-key) (defface which-key-group-description-face '((t . (:inherit font-lock-keyword-face))) - "Face for the key description when it is a group or prefix") + "Face for the key description when it is a group or prefix" + :group 'which-key) (defface which-key-special-key-face '((t . (:inherit which-key-key-face :inverse-video t :weight bold))) - "Face for special keys (SPC, TAB, RET)") + "Face for special keys (SPC, TAB, RET)" + :group 'which-key) ;; Internal Vars ;; (defvar popwin:popup-buffer nil) commit 78c3759f07768dfb94954ae879bfc29cb5b7adee Author: Justin Burkett Date: Wed Jul 8 07:37:41 2015 -0400 Require cl-lib Addresses #15 diff --git a/which-key.el b/which-key.el index 47566ce642e..e872f08a978 100644 --- a/which-key.el +++ b/which-key.el @@ -21,8 +21,7 @@ ;;; Code: -(require 'cl-macs) -(require 'cl-extra) +(require 'cl-lib) (require 's) (defvar which-key-idle-delay 1 commit c3586da3d294822afc78a758acb42753479624b1 Author: Justin Burkett Date: Tue Jul 7 20:12:01 2015 -0400 Add key-based replacement list diff --git a/which-key.el b/which-key.el index acf441a5858..47566ce642e 100644 --- a/which-key.el +++ b/which-key.el @@ -50,6 +50,9 @@ cells for replacing descriptions. The second one removes \"namespace/\" from \"namespace/function\". This is a convention for naming functions but not a rule, so remove this replacement if it becomes problematic.") +(defvar which-key-key-based-description-replacement-alist + '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1") + ("SPC f f" "find files" t))) (defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") "These keys will automatically be truncated to one character and have `which-key-special-key-face' applied to them.") @@ -351,7 +354,7 @@ of the intended popup." desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted :test (lambda (x y) (string-equal (car x) (car y))))) - (setq format-res (which-key/format-matches unformatted) + (setq format-res (which-key/format-matches unformatted (key-description key)) formatted (car format-res) column-width (cdr format-res))) (cons formatted column-width))) @@ -407,18 +410,21 @@ the maximum number of lines availabel in the target buffer." (goto-char (point-min))))) (cons act-height act-width))) -(defun which-key/maybe-replace (string repl-alist &optional literal) +(defun which-key/maybe-replace (string repl-alist &optional keys literal) "Perform replacements on STRING. REPL-ALIST is an alist where the car of each element is the text to replace and the cdr is the replacement text. Unless LITERAL is non-nil regexp is used in the replacements." (let ((new-string string)) - (dolist (repl repl-alist) - (setq new-string - (if (string-match (car repl) new-string) - (replace-match (cdr repl) t literal new-string) - new-string))) - new-string)) + (if keys + (dolist (repl repl-alist) + (when (and (string-equal (nth 0 repl) keys)) + (setq new-string (nth 1 repl)))) + (dolist (repl repl-alist) + (when (string-match (car repl) new-string) + (setq new-string + (replace-match (cdr repl) t literal new-string))))) + new-string)) (defun which-key/propertize-key (key) (let ((key-w-face (propertize key 'face 'which-key-key-face))) @@ -428,7 +434,7 @@ non-nil regexp is used in the replacements." (setq key-w-face (concat (substring key-w-face 0 beg) (propertize (substring key-w-face beg (1+ beg)) - 'face 'which-key-special-key-face) + 'face 'which-key-special-key-face) (when (< end (length key-w-face)) (substring key-w-face end (length key-w-face)))))))) key-w-face)) @@ -439,7 +445,7 @@ non-nil regexp is used in the replacements." (concat (substring desc 0 which-key-max-description-length) "..") desc)) -(defun which-key/format-matches (unformatted) +(defun which-key/format-matches (unformatted prefix-keys) "Turn each key-desc-cons in UNFORMATTED into formatted strings (including text properties), and pad with spaces so that all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the @@ -455,10 +461,14 @@ replacement alists." (setq after-replacements (mapcar (lambda (key-desc-cons) - (let* ((key (which-key/maybe-replace + (let* ((keys (concat prefix-keys " " (car key-desc-cons))) + (key (which-key/maybe-replace (car key-desc-cons) which-key-key-replacement-alist)) (desc (which-key/maybe-replace (cdr key-desc-cons) which-key-description-replacement-alist)) + (desc (which-key/maybe-replace + (cdr key-desc-cons) which-key-key-based-description-replacement-alist + keys)) (group (string-match-p "^group:" desc)) (desc (if group (substring desc 6) desc)) (prefix (string-match-p "^Prefix" desc)) commit dc4391e73d1323ee011c465ab3744af9272f546d Author: Justin Burkett Date: Tue Jul 7 19:39:38 2015 -0400 Add regexp to remove namespace (w minor cleanup) diff --git a/which-key.el b/which-key.el index 07d0388b215..acf441a5858 100644 --- a/which-key.el +++ b/which-key.el @@ -44,9 +44,12 @@ popup.") "The strings in the car of each cons cell are replaced with the strings in the cdr for each key.") (defvar which-key-description-replacement-alist - '(("Prefix Command" . "prefix")) - "See `which-key-key-replacement-alist'. This is a list of cons -cells for replacing descriptions.") + '(("Prefix Command" . "prefix") (".+/\\(.+\\)" . "\\1")) + "See `which-key-key-replacement-alist'. This is a list of cons +cells for replacing descriptions. The second one removes +\"namespace/\" from \"namespace/function\". This is a convention +for naming functions but not a rule, so remove this replacement +if it becomes problematic.") (defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") "These keys will automatically be truncated to one character and have `which-key-special-key-face' applied to them.") @@ -171,11 +174,6 @@ Finally, show the buffer." ;; Show/hide guide buffer -;; Should this be used instead? -;; (defun which-key/hide-buffer-display-buffer () -;; (when (window-live-p which-key--window) -;; (delete-window which-key--window))) - (defun which-key/hide-popup () (cl-case which-key-popup-type (minibuffer (which-key/hide-buffer-minibuffer)) @@ -392,9 +390,10 @@ the maximum number of lines availabel in the target buffer." (when (and (> n-keys 0) (> n-columns 0)) (dotimes (p n-pages) (setq pages - (push (which-key/create-page prefix-len max-height n-columns - (cl-subseq formatted-keys (* p max-keys/page) - (min (* (1+ p) max-keys/page) n-keys))) pages))) + (push (which-key/create-page + prefix-len max-height n-columns + (cl-subseq formatted-keys (* p max-keys/page) + (min (* (1+ p) max-keys/page) n-keys))) pages))) ;; not doing anything with other pages for now (setq pages (reverse pages) act-height (1+ (s-count-matches "\n" (car pages)))) commit 9838d3b8d40b23cb4aeb5edb3e354bfc717aa1b9 Author: Justin Burkett Date: Tue Jul 7 19:25:57 2015 -0400 Remove column-width from max-dimensions It's not needed diff --git a/which-key.el b/which-key.el index c01159d5538..07d0388b215 100644 --- a/which-key.el +++ b/which-key.el @@ -303,12 +303,12 @@ need to start the closing timer." ;; Size functions -(defun which-key/popup-max-dimensions (column-width selected-window-width) +(defun which-key/popup-max-dimensions (selected-window-width) "Dimesion functions should return the maximum possible (height . width) of the intended popup." (cl-case which-key-popup-type (minibuffer (which-key/minibuffer-max-dimensions)) - (side-window (which-key/side-window-max-dimensions column-width)) + (side-window (which-key/side-window-max-dimensions)) (frame (which-key/frame-max-dimensions)))) (defun which-key/minibuffer-max-dimensions () @@ -321,7 +321,7 @@ of the intended popup." ;; width (frame-text-cols))) -(defun which-key/side-window-max-dimensions (column-width) +(defun which-key/side-window-max-dimensions () (cons ;; height (if (member which-key-side-window-location '(left right)) @@ -330,7 +330,7 @@ of the intended popup." which-key-side-window-max-height) ;; width (if (member which-key-side-window-location '(left right)) - (min which-key-side-window-max-width column-width) + which-key-side-window-max-width (frame-width)))) (defun which-key/frame-max-dimensions () @@ -378,7 +378,7 @@ the maximum number of lines availabel in the target buffer." (let* ((prefix-w-face (which-key/propertize-key prefix-keys)) (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) (n-keys (length formatted-keys)) - (max-dims (which-key/popup-max-dimensions column-width sel-win-width)) + (max-dims (which-key/popup-max-dimensions sel-win-width)) (max-height (when (car max-dims) (car max-dims))) (max-width (when (cdr max-dims) (cdr max-dims))) ;; the 3 leaves room for the ... possibly on the first page commit 40ac541bc7a9c933503f99c2fee3f569cf13611f Author: Justin Burkett Date: Tue Jul 7 16:19:45 2015 -0400 Show prefix in popup diff --git a/which-key.el b/which-key.el index 344974ac644..c01159d5538 100644 --- a/which-key.el +++ b/which-key.el @@ -152,17 +152,18 @@ Used when `which-key-popup-type' is frame.") (defun which-key/update () "Fill which-key--buffer with key descriptions and reformat. Finally, show the buffer." - (let ((key (this-single-command-keys))) - (if (> (length key) 0) + (let ((prefix-keys (this-single-command-keys))) + (if (> (length prefix-keys) 0) (progn (let* ((buf (current-buffer)) ;; get formatted key bindings - (fmt-width-cons (which-key/get-formatted-key-bindings buf key)) + (fmt-width-cons (which-key/get-formatted-key-bindings buf prefix-keys)) (formatted-keys (car fmt-width-cons)) (column-width (cdr fmt-width-cons)) ;; populate target buffer (popup-act-dim - (which-key/populate-buffer formatted-keys column-width (window-width)))) + (which-key/populate-buffer (key-description prefix-keys) + formatted-keys column-width (window-width)))) ;; show buffer (which-key/show-popup popup-act-dim))) ;; command finished maybe close the window @@ -357,27 +358,31 @@ of the intended popup." column-width (cdr format-res))) (cons formatted column-width))) -(defun which-key/create-page (max-lines n-columns keys) +(defun which-key/create-page (prefix-len max-lines n-columns keys) "Format KEYS into string representing a single page of text. N-COLUMNS is the number of text columns to use and MAX-LINES is the maximum number of lines availabel in the target buffer." (let* ((n-keys (length keys)) (n-lines (min (ceiling (/ (float n-keys) n-columns)) max-lines)) + (line-padding (s-repeat prefix-len " ")) lines) (dotimes (i n-lines) (setq lines (push (cl-subseq keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) lines))) - (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n"))) + (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) (concat "\n" line-padding)))) -(defun which-key/populate-buffer (formatted-keys column-width sel-win-width) +(defun which-key/populate-buffer (prefix-keys formatted-keys column-width sel-win-width) "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." - (let* ((n-keys (length formatted-keys)) + (let* ((prefix-w-face (which-key/propertize-key prefix-keys)) + (prefix-len (+ 2 (length (substring-no-properties prefix-w-face)))) + (n-keys (length formatted-keys)) (max-dims (which-key/popup-max-dimensions column-width sel-win-width)) (max-height (when (car max-dims) (car max-dims))) (max-width (when (cdr max-dims) (cdr max-dims))) - (n-columns (/ max-width column-width)) ;; integer division + ;; the 3 leaves room for the ... possibly on the first page + (n-columns (/ (- max-width prefix-len 3) column-width)) ;; integer division (act-width (* n-columns column-width)) ;; (avl-lines/page (which-key/available-lines)) (max-keys/page (when max-height (* n-columns max-height))) @@ -387,13 +392,13 @@ the maximum number of lines availabel in the target buffer." (when (and (> n-keys 0) (> n-columns 0)) (dotimes (p n-pages) (setq pages - (push (which-key/create-page max-height n-columns + (push (which-key/create-page prefix-len max-height n-columns (cl-subseq formatted-keys (* p max-keys/page) (min (* (1+ p) max-keys/page) n-keys))) pages))) ;; not doing anything with other pages for now (setq pages (reverse pages) act-height (1+ (s-count-matches "\n" (car pages)))) - (setq first-page (car pages)) + (setq first-page (concat prefix-w-face " " (car pages))) (when (> (length pages) 1) (setq first-page (concat first-page "..."))) (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" first-page)) @@ -420,13 +425,13 @@ non-nil regexp is used in the replacements." (let ((key-w-face (propertize key 'face 'which-key-key-face))) (dolist (special-key which-key-special-keys) (when (string-match special-key key) - (setq key-w-face - (concat (substring key-w-face 0 (match-beginning 0)) - (propertize - (substring key-w-face (match-beginning 0) (1+ (match-beginning 0))) - 'face 'which-key-special-key-face) - (when (< (match-end 0) (length key-w-face)) - (substring key-w-face (1+ (match-end 0)) (length key-w-face))))))) + (let ((beg (match-beginning 0)) (end (match-end 0))) + (setq key-w-face + (concat (substring key-w-face 0 beg) + (propertize (substring key-w-face beg (1+ beg)) + 'face 'which-key-special-key-face) + (when (< end (length key-w-face)) + (substring key-w-face end (length key-w-face)))))))) key-w-face)) (defsubst which-key/truncate-description (desc) commit be7f2c9f5fb7a1ec2262245d68e7936ab4fad2bb Author: Justin Burkett Date: Tue Jul 7 15:21:57 2015 -0400 Remove commented out close timer stuff Closes #10 diff --git a/which-key.el b/which-key.el index 8c4317e25a0..344974ac644 100644 --- a/which-key.el +++ b/which-key.el @@ -27,8 +27,6 @@ (defvar which-key-idle-delay 1 "Delay (in seconds) for which-key buffer to popup.") -;; (defvar which-key-close-buffer-idle-delay 4 -;; "Delay (in seconds) after which buffer is forced closed.") (defvar which-key-echo-keystrokes (min echo-keystrokes (/ (float which-key-idle-delay) 4)) "Value to use for echo-keystrokes. This only applies when @@ -95,8 +93,6 @@ location is top or bottom.") "Internal: Holds reference to which-key window.") (defvar which-key--open-timer nil "Internal: Holds reference to open window timer.") -;; (defvar which-key--close-timer nil -;; "Internal: Holds reference to close window timer.") (defvar which-key--setup-p nil "Internal: Non-nil if which-key buffer has been setup.") (defvar which-key--frame nil @@ -130,7 +126,6 @@ Used when `which-key-popup-type' is frame.") (remove-hook 'focus-out-hook #'which-key/stop-open-timer) (remove-hook 'focus-in-hook #'which-key/start-open-timer) (which-key/stop-open-timer))) -;; (which-key/stop-close-timer))) (defun which-key/setup () "Create buffer for which-key." @@ -152,17 +147,6 @@ Used when `which-key-popup-type' is frame.") "Deactivate idle timer." (when which-key--open-timer (cancel-timer which-key--open-timer))) -;; (defun which-key/start-close-timer () -;; "Activate idle timer." -;; (which-key/stop-close-timer) ; start over -;; (setq which-key--close-timer -;; (run-at-time which-key-close-buffer-idle-delay -;; nil 'which-key/hide-popup))) - -;; (defun which-key/stop-close-timer () -;; "Deactivate idle timer." -;; (when which-key--close-timer (cancel-timer which-key--close-timer))) - ;; Update (defun which-key/update () @@ -171,10 +155,6 @@ Finally, show the buffer." (let ((key (this-single-command-keys))) (if (> (length key) 0) (progn - ;; (which-key/stop-close-timer) - ;; remove this because `which-key/show-popup' should be able to - ;; handle the case where which-key buffer is already displayed - ;; (which-key/hide-popup) (let* ((buf (current-buffer)) ;; get formatted key bindings (fmt-width-cons (which-key/get-formatted-key-bindings buf key)) @@ -185,8 +165,6 @@ Finally, show the buffer." (which-key/populate-buffer formatted-keys column-width (window-width)))) ;; show buffer (which-key/show-popup popup-act-dim))) - ;; (when (which-key/show-popup popup-act-dim) - ;; (which-key/start-close-timer)))) ;; command finished maybe close the window (which-key/hide-popup)))) commit c6c50bbe4c7c2856380796b1b7e042f342a7afee Author: Justin Burkett Date: Tue Jul 7 15:11:46 2015 -0400 Make echo-keystrokes a variable and speed it up. diff --git a/which-key.el b/which-key.el index 1d2c7586ca8..8c4317e25a0 100644 --- a/which-key.el +++ b/which-key.el @@ -29,6 +29,12 @@ "Delay (in seconds) for which-key buffer to popup.") ;; (defvar which-key-close-buffer-idle-delay 4 ;; "Delay (in seconds) after which buffer is forced closed.") +(defvar which-key-echo-keystrokes + (min echo-keystrokes (/ (float which-key-idle-delay) 4)) + "Value to use for echo-keystrokes. This only applies when +`which-key-popup-type' is minibuffer. It needs to be less than +`which-key-idle-delay' or else the echo will erase the which-key +popup.") (defvar which-key-max-description-length 27 "Truncate the description of keys to this length. Also adds \"..\".") @@ -107,12 +113,11 @@ Used when `which-key-popup-type' is frame.") (if which-key-mode (progn (unless which-key--setup-p (which-key/setup)) - ;; reduce echo-keytrokes for minibuffer popup + ;; reduce echo-keystrokes for minibuffer popup ;; (it can interfer if it's too slow) (when (and (> echo-keystrokes 0) (eq which-key-popup-type 'minibuffer)) - (setq echo-keystrokes - (min echo-keystrokes (/ (float which-key-idle-delay) 2))) + (setq echo-keystrokes which-key-echo-keystrokes) (message "Which-key-mode enabled (note echo-keystrokes changed from %s to %s)" which-key--echo-keystrokes-backup echo-keystrokes)) (add-hook 'pre-command-hook #'which-key/hide-popup) commit a09f70c5879b0341a838504ed5c2903c7e7f50c9 Author: Justin Burkett Date: Tue Jul 7 15:06:06 2015 -0400 Be consistent in defining faces. diff --git a/which-key.el b/which-key.el index 1a25433c67a..1d2c7586ca8 100644 --- a/which-key.el +++ b/which-key.el @@ -43,7 +43,9 @@ strings in the cdr for each key.") '(("Prefix Command" . "prefix")) "See `which-key-key-replacement-alist'. This is a list of cons cells for replacing descriptions.") -(defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL")) +(defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL") + "These keys will automatically be truncated to one character +and have `which-key-special-key-face' applied to them.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-popup-type 'minibuffer @@ -63,12 +65,20 @@ location is top or bottom.") "Maximum height of which-key popup when type is frame.") ;; Faces -(defvar which-key-key-face 'font-lock-constant-face) -(defvar which-key-separator-face 'font-lock-comment-face) -(defvar which-key-group-description-face 'font-lock-keyword-face) -(defvar which-key-command-description-face 'font-lock-function-name-face) +(defface which-key-key-face + '((t . (:inherit font-lock-constant-face))) + "Face for which-key keys") +(defface which-key-separator-face + '((t . (:inherit font-lock-comment-face))) + "Face for the separator (default separator is an arrow)") +(defface which-key-command-description-face + '((t . (:inherit font-lock-function-name-face))) + "Face for the key description when it is a command") +(defface which-key-group-description-face + '((t . (:inherit font-lock-keyword-face))) + "Face for the key description when it is a group or prefix") (defface which-key-special-key-face - `((t . (:inherit ,which-key-key-face :inverse-video t :weight bold)) ) + '((t . (:inherit which-key-key-face :inverse-video t :weight bold))) "Face for special keys (SPC, TAB, RET)") ;; Internal Vars @@ -424,7 +434,7 @@ non-nil regexp is used in the replacements." new-string)) (defun which-key/propertize-key (key) - (let ((key-w-face (propertize key 'face which-key-key-face))) + (let ((key-w-face (propertize key 'face 'which-key-key-face))) (dolist (special-key which-key-special-keys) (when (string-match special-key key) (setq key-w-face @@ -451,7 +461,7 @@ Replacements are performed using the key and description replacement alists." (let ((max-key-width 0) (max-desc-width 0) - (sep-w-face (propertize which-key-separator 'face which-key-separator-face)) + (sep-w-face (propertize which-key-separator 'face 'which-key-separator-face)) (sep-width (length which-key-separator)) after-replacements) ;; first replace and apply faces @@ -467,8 +477,8 @@ replacement alists." (prefix (string-match-p "^Prefix" desc)) (desc (if (or prefix group) (concat "+" desc) desc)) (desc-face (if (or prefix group) - which-key-group-description-face - which-key-command-description-face)) + 'which-key-group-description-face + 'which-key-command-description-face)) (desc (which-key/truncate-description desc)) (key-w-face (which-key/propertize-key key)) (desc-w-face (propertize desc 'face desc-face)) commit f122d3d42e5b5c0775826247f8d6622bc63e9d94 Author: Justin Burkett Date: Tue Jul 7 15:00:10 2015 -0400 Make default delay less aggressive. Also avoids touching echo-keystrokes if it is already low. diff --git a/which-key.el b/which-key.el index b42279b2458..1a25433c67a 100644 --- a/which-key.el +++ b/which-key.el @@ -25,7 +25,7 @@ (require 'cl-extra) (require 's) -(defvar which-key-idle-delay 0.6 +(defvar which-key-idle-delay 1 "Delay (in seconds) for which-key buffer to popup.") ;; (defvar which-key-close-buffer-idle-delay 4 ;; "Delay (in seconds) after which buffer is forced closed.") @@ -97,11 +97,14 @@ Used when `which-key-popup-type' is frame.") (if which-key-mode (progn (unless which-key--setup-p (which-key/setup)) - ;; make echo-keytrokes fast for minibuffer popup + ;; reduce echo-keytrokes for minibuffer popup ;; (it can interfer if it's too slow) (when (and (> echo-keystrokes 0) (eq which-key-popup-type 'minibuffer)) - (setq echo-keystrokes 0.1)) + (setq echo-keystrokes + (min echo-keystrokes (/ (float which-key-idle-delay) 2))) + (message "Which-key-mode enabled (note echo-keystrokes changed from %s to %s)" + which-key--echo-keystrokes-backup echo-keystrokes)) (add-hook 'pre-command-hook #'which-key/hide-popup) (add-hook 'focus-out-hook #'which-key/stop-open-timer) (add-hook 'focus-in-hook #'which-key/start-open-timer) commit bfdae2557fabc3be3cb262e4ae61e924a1808108 Author: Justin Burkett Date: Tue Jul 7 13:27:08 2015 -0400 Maek special keys bold diff --git a/which-key.el b/which-key.el index 9a45cf18830..b42279b2458 100644 --- a/which-key.el +++ b/which-key.el @@ -68,7 +68,7 @@ location is top or bottom.") (defvar which-key-group-description-face 'font-lock-keyword-face) (defvar which-key-command-description-face 'font-lock-function-name-face) (defface which-key-special-key-face - `((t . (:inherit ,which-key-key-face :inverse-video t)) ) + `((t . (:inherit ,which-key-key-face :inverse-video t :weight bold)) ) "Face for special keys (SPC, TAB, RET)") ;; Internal Vars commit 2e904d29308e9dc0865c4ba3392614ae930e7341 Author: Justin Burkett Date: Tue Jul 7 13:24:39 2015 -0400 Add DEL to special keys diff --git a/which-key.el b/which-key.el index d2b06cfb0f4..9a45cf18830 100644 --- a/which-key.el +++ b/which-key.el @@ -43,7 +43,7 @@ strings in the cdr for each key.") '(("Prefix Command" . "prefix")) "See `which-key-key-replacement-alist'. This is a list of cons cells for replacing descriptions.") -(defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC")) +(defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL")) (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-popup-type 'minibuffer commit 2393a70a1ceb7b28eeb510a53ef9cd976e796c45 Author: Justin Burkett Date: Tue Jul 7 11:08:11 2015 -0400 Add small indication of more pages diff --git a/which-key.el b/which-key.el index 8ae01e55079..d2b06cfb0f4 100644 --- a/which-key.el +++ b/which-key.el @@ -387,7 +387,7 @@ the maximum number of lines availabel in the target buffer." (max-keys/page (when max-height (* n-columns max-height))) (n-pages (if max-keys/page (ceiling (/ (float n-keys) max-keys/page)) 1)) - pages act-height) + pages act-height first-page) (when (and (> n-keys 0) (> n-columns 0)) (dotimes (p n-pages) (setq pages @@ -397,11 +397,13 @@ the maximum number of lines availabel in the target buffer." ;; not doing anything with other pages for now (setq pages (reverse pages) act-height (1+ (s-count-matches "\n" (car pages)))) + (setq first-page (car pages)) + (when (> (length pages) 1) (setq first-page (concat first-page "..."))) (if (eq which-key-popup-type 'minibuffer) - (let (message-log-max) (message "%s" (car pages))) + (let (message-log-max) (message "%s" first-page)) (with-current-buffer which-key--buffer (erase-buffer) - (insert (car pages)) + (insert first-page) (goto-char (point-min))))) (cons act-height act-width))) commit 50962765d1cd27ce0dc5697e2ea63e5488a1532b Author: Justin Burkett Date: Tue Jul 7 10:58:13 2015 -0400 Pull out faces and add special key face Special keys (SPC, TAB, RET and ESC) are now truncated to one character and shown in inverse-video to distinguish them from S, T, R and E diff --git a/which-key.el b/which-key.el index 13b313dedd7..8ae01e55079 100644 --- a/which-key.el +++ b/which-key.el @@ -43,6 +43,7 @@ strings in the cdr for each key.") '(("Prefix Command" . "prefix")) "See `which-key-key-replacement-alist'. This is a list of cons cells for replacing descriptions.") +(defvar which-key-special-keys '("SPC" "TAB" "RET" "ESC")) (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-popup-type 'minibuffer @@ -61,6 +62,15 @@ location is top or bottom.") (defvar which-key-frame-max-height 20 "Maximum height of which-key popup when type is frame.") +;; Faces +(defvar which-key-key-face 'font-lock-constant-face) +(defvar which-key-separator-face 'font-lock-comment-face) +(defvar which-key-group-description-face 'font-lock-keyword-face) +(defvar which-key-command-description-face 'font-lock-function-name-face) +(defface which-key-special-key-face + `((t . (:inherit ,which-key-key-face :inverse-video t)) ) + "Face for special keys (SPC, TAB, RET)") + ;; Internal Vars ;; (defvar popwin:popup-buffer nil) (defvar which-key--buffer nil @@ -102,7 +112,7 @@ Used when `which-key-popup-type' is frame.") (remove-hook 'focus-out-hook #'which-key/stop-open-timer) (remove-hook 'focus-in-hook #'which-key/start-open-timer) (which-key/stop-open-timer))) - ;; (which-key/stop-close-timer))) +;; (which-key/stop-close-timer))) (defun which-key/setup () "Create buffer for which-key." @@ -157,8 +167,8 @@ Finally, show the buffer." (which-key/populate-buffer formatted-keys column-width (window-width)))) ;; show buffer (which-key/show-popup popup-act-dim))) - ;; (when (which-key/show-popup popup-act-dim) - ;; (which-key/start-close-timer)))) + ;; (when (which-key/show-popup popup-act-dim) + ;; (which-key/start-close-timer)))) ;; command finished maybe close the window (which-key/hide-popup)))) @@ -238,11 +248,11 @@ need to start the closing timer." ;; 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)))) + (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)) @@ -332,9 +342,9 @@ of the intended popup." ;; Buffer contents functions (defun which-key/get-formatted-key-bindings (buffer key) - (let ((max-len-key 0) (max-len-desc 0) - (key-str-qt (regexp-quote (key-description key))) - key-match desc-match unformatted formatted) + (let ((key-str-qt (regexp-quote (key-description key))) + key-match desc-match unformatted format-res + formatted column-width) (with-temp-buffer (describe-buffer-bindings buffer key) (goto-char (point-max)) ; want to put last keys in first @@ -343,17 +353,13 @@ of the intended popup." key-str-qt) nil t) (setq key-match (match-string 1) - desc-match (match-string 2) - max-len-key (max max-len-key (length key-match)) - max-len-desc (max max-len-desc (length desc-match))) + desc-match (match-string 2)) (cl-pushnew (cons key-match desc-match) unformatted :test (lambda (x y) (string-equal (car x) (car y))))) - (setq max-len-desc (if (> max-len-desc which-key-max-description-length) - (+ 2 which-key-max-description-length) ; for the .. - max-len-desc) - formatted (which-key/format-matches - unformatted max-len-key max-len-desc))) - (cons formatted (+ 4 max-len-key max-len-desc)))) + (setq format-res (which-key/format-matches unformatted) + formatted (car format-res) + column-width (cdr format-res))) + (cons formatted column-width))) (defun which-key/create-page (max-lines n-columns keys) "Format KEYS into string representing a single page of text. @@ -386,8 +392,8 @@ the maximum number of lines availabel in the target buffer." (dotimes (p n-pages) (setq pages (push (which-key/create-page max-height n-columns - (cl-subseq formatted-keys (* p max-keys/page) - (min (* (1+ p) max-keys/page) n-keys))) pages))) + (cl-subseq formatted-keys (* p max-keys/page) + (min (* (1+ p) max-keys/page) n-keys))) pages))) ;; not doing anything with other pages for now (setq pages (reverse pages) act-height (1+ (s-count-matches "\n" (car pages)))) @@ -399,17 +405,31 @@ the maximum number of lines availabel in the target buffer." (goto-char (point-min))))) (cons act-height act-width))) -(defun which-key/maybe-replace (text repl-alist &optional literal) - "Perform replacements on TEXT. +(defun which-key/maybe-replace (string repl-alist &optional literal) + "Perform replacements on STRING. REPL-ALIST is an alist where the car of each element is the text to replace and the cdr is the replacement text. Unless LITERAL is non-nil regexp is used in the replacements." - (dolist (repl repl-alist) - (setq text - (if (string-match (car repl) text) - (replace-match (cdr repl) t literal text) - text))) - text) + (let ((new-string string)) + (dolist (repl repl-alist) + (setq new-string + (if (string-match (car repl) new-string) + (replace-match (cdr repl) t literal new-string) + new-string))) + new-string)) + +(defun which-key/propertize-key (key) + (let ((key-w-face (propertize key 'face which-key-key-face))) + (dolist (special-key which-key-special-keys) + (when (string-match special-key key) + (setq key-w-face + (concat (substring key-w-face 0 (match-beginning 0)) + (propertize + (substring key-w-face (match-beginning 0) (1+ (match-beginning 0))) + 'face 'which-key-special-key-face) + (when (< (match-end 0) (length key-w-face)) + (substring key-w-face (1+ (match-end 0)) (length key-w-face))))))) + key-w-face)) (defsubst which-key/truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." @@ -417,35 +437,51 @@ non-nil regexp is used in the replacements." (concat (substring desc 0 which-key-max-description-length) "..") desc)) -(defun which-key/format-matches (unformatted max-len-key max-len-desc) +(defun which-key/format-matches (unformatted) "Turn each key-desc-cons in UNFORMATTED into formatted strings (including text properties), and pad with spaces so that all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the longest key and description in the buffer, respectively. Replacements are performed using the key and description replacement alists." - (mapcar - (lambda (key-desc-cons) - (let* ((key (which-key/maybe-replace (car key-desc-cons) - which-key-key-replacement-alist)) - (desc (which-key/maybe-replace (cdr key-desc-cons) - which-key-description-replacement-alist)) - (group (string-match-p "^group:" desc)) - (desc (if group (substring desc 6) desc)) - (prefix (string-match-p "^Prefix" desc)) - (desc (if (or prefix group) (concat "+" desc) desc)) - (desc-face (if (or prefix group) - 'font-lock-keyword-face 'font-lock-function-name-face)) - (separator which-key-separator) - (desc (which-key/truncate-description desc)) - ;; pad keys to max-len-key - (padded-key (s-pad-left max-len-key " " key)) - (padded-desc (s-pad-right max-len-desc " " desc))) - (format (concat (propertize "%s" 'face 'font-lock-constant-face) " " - (propertize separator 'face 'font-lock-comment-face) " " - (propertize "%s" 'face desc-face) " ") - padded-key padded-desc))) - unformatted)) + (let ((max-key-width 0) + (max-desc-width 0) + (sep-w-face (propertize which-key-separator 'face which-key-separator-face)) + (sep-width (length which-key-separator)) + after-replacements) + ;; first replace and apply faces + (setq after-replacements + (mapcar + (lambda (key-desc-cons) + (let* ((key (which-key/maybe-replace + (car key-desc-cons) which-key-key-replacement-alist)) + (desc (which-key/maybe-replace + (cdr key-desc-cons) which-key-description-replacement-alist)) + (group (string-match-p "^group:" desc)) + (desc (if group (substring desc 6) desc)) + (prefix (string-match-p "^Prefix" desc)) + (desc (if (or prefix group) (concat "+" desc) desc)) + (desc-face (if (or prefix group) + which-key-group-description-face + which-key-command-description-face)) + (desc (which-key/truncate-description desc)) + (key-w-face (which-key/propertize-key key)) + (desc-w-face (propertize desc 'face desc-face)) + (key-width (length (substring-no-properties key-w-face))) + (desc-width (length (substring-no-properties desc-w-face)))) + (setq max-key-width (max key-width max-key-width)) + (setq max-desc-width (max desc-width max-desc-width)) + (cons key-w-face desc-w-face))) + unformatted)) + ;; pad to max key-width and max desc-width + (cons + (mapcar (lambda (x) + (concat (s-pad-left max-key-width " " (car x)) + " " sep-w-face " " + (s-pad-right max-desc-width " " (cdr x)) + " ")) + after-replacements) + (+ 3 max-key-width sep-width max-desc-width )))) (provide 'which-key) commit 9e09f05f614c378c31979da67c9a72cf06bd5e00 Author: Justin Burkett Date: Mon Jul 6 15:50:42 2015 -0400 Need cl for emacs < 25 diff --git a/which-key.el b/which-key.el index 7f5229d3f08..13b313dedd7 100644 --- a/which-key.el +++ b/which-key.el @@ -21,6 +21,8 @@ ;;; Code: +(require 'cl-macs) +(require 'cl-extra) (require 's) (defvar which-key-idle-delay 0.6 @@ -363,7 +365,7 @@ the maximum number of lines availabel in the target buffer." (dotimes (i n-lines) (setq lines (push - (seq-subseq keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) + (cl-subseq keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) lines))) (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n"))) @@ -384,7 +386,7 @@ the maximum number of lines availabel in the target buffer." (dotimes (p n-pages) (setq pages (push (which-key/create-page max-height n-columns - (seq-subseq formatted-keys (* p max-keys/page) + (cl-subseq formatted-keys (* p max-keys/page) (min (* (1+ p) max-keys/page) n-keys))) pages))) ;; not doing anything with other pages for now (setq pages (reverse pages) commit 2e9ec6bae2a5233848fcd626d4b1687875e60f41 Author: Justin Burkett Date: Mon Jul 6 15:25:49 2015 -0400 Fix compiler warnings diff --git a/.gitignore b/.gitignore index 34da34edea6..77633d2fc83 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ *~ +*.elc # Used to setup library paths for emacs -Q private-test-setup.el diff --git a/which-key.el b/which-key.el index 728fdb138bc..7f5229d3f08 100644 --- a/which-key.el +++ b/which-key.el @@ -21,6 +21,8 @@ ;;; Code: +(require 's) + (defvar which-key-idle-delay 0.6 "Delay (in seconds) for which-key buffer to popup.") ;; (defvar which-key-close-buffer-idle-delay 4 @@ -97,14 +99,11 @@ Used when `which-key-popup-type' is frame.") (remove-hook 'pre-command-hook #'which-key/hide-popup) (remove-hook 'focus-out-hook #'which-key/stop-open-timer) (remove-hook 'focus-in-hook #'which-key/start-open-timer) - (which-key/stop-open-timer) - (which-key/stop-close-timer))) + (which-key/stop-open-timer))) + ;; (which-key/stop-close-timer))) (defun which-key/setup () "Create buffer for which-key." - (require 'cl) - (require 's) -;; (require 'popwin) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer (setq-local cursor-type nil) @@ -364,7 +363,7 @@ the maximum number of lines availabel in the target buffer." (dotimes (i n-lines) (setq lines (push - (subseq keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) + (seq-subseq keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) lines))) (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n"))) @@ -385,7 +384,7 @@ the maximum number of lines availabel in the target buffer." (dotimes (p n-pages) (setq pages (push (which-key/create-page max-height n-columns - (subseq formatted-keys (* p max-keys/page) + (seq-subseq formatted-keys (* p max-keys/page) (min (* (1+ p) max-keys/page) n-keys))) pages))) ;; not doing anything with other pages for now (setq pages (reverse pages) commit a657ea8fafe5000719f8ef0cdfc35d6294559cd7 Author: Justin Burkett Date: Mon Jul 6 14:40:07 2015 -0400 Change side-window default position to right diff --git a/which-key.el b/which-key.el index 28f579c4e0d..728fdb138bc 100644 --- a/which-key.el +++ b/which-key.el @@ -43,7 +43,7 @@ cells for replacing descriptions.") "Name of which-key buffer.") (defvar which-key-popup-type 'minibuffer "Supported types are minibuffer, side-window and frame.") -(defvar which-key-side-window-location 'bottom +(defvar which-key-side-window-location 'right "Location of which-key popup when `which-key-popup-type' is side-window. Should be one of top, bottom, left or right.") (defvar which-key-side-window-max-width 60 commit b2ea6227c3c1ed3433a58a41518a3017ee5c8304 Author: Justin Burkett Date: Mon Jul 6 14:37:27 2015 -0400 Try without close timer diff --git a/which-key.el b/which-key.el index c191d9137de..28f579c4e0d 100644 --- a/which-key.el +++ b/which-key.el @@ -23,8 +23,8 @@ (defvar which-key-idle-delay 0.6 "Delay (in seconds) for which-key buffer to popup.") -(defvar which-key-close-buffer-idle-delay 4 - "Delay (in seconds) after which buffer is forced closed.") +;; (defvar which-key-close-buffer-idle-delay 4 +;; "Delay (in seconds) after which buffer is forced closed.") (defvar which-key-max-description-length 27 "Truncate the description of keys to this length. Also adds \"..\".") @@ -65,8 +65,8 @@ location is top or bottom.") "Internal: Holds reference to which-key window.") (defvar which-key--open-timer nil "Internal: Holds reference to open window timer.") -(defvar which-key--close-timer nil - "Internal: Holds reference to close window timer.") +;; (defvar which-key--close-timer nil +;; "Internal: Holds reference to close window timer.") (defvar which-key--setup-p nil "Internal: Non-nil if which-key buffer has been setup.") (defvar which-key--frame nil @@ -123,16 +123,16 @@ Used when `which-key-popup-type' is frame.") "Deactivate idle timer." (when which-key--open-timer (cancel-timer which-key--open-timer))) -(defun which-key/start-close-timer () - "Activate idle timer." - (which-key/stop-close-timer) ; start over - (setq which-key--close-timer - (run-at-time which-key-close-buffer-idle-delay - nil 'which-key/hide-popup))) +;; (defun which-key/start-close-timer () +;; "Activate idle timer." +;; (which-key/stop-close-timer) ; start over +;; (setq which-key--close-timer +;; (run-at-time which-key-close-buffer-idle-delay +;; nil 'which-key/hide-popup))) -(defun which-key/stop-close-timer () - "Deactivate idle timer." - (when which-key--close-timer (cancel-timer which-key--close-timer))) +;; (defun which-key/stop-close-timer () +;; "Deactivate idle timer." +;; (when which-key--close-timer (cancel-timer which-key--close-timer))) ;; Update @@ -142,7 +142,7 @@ Finally, show the buffer." (let ((key (this-single-command-keys))) (if (> (length key) 0) (progn - (which-key/stop-close-timer) + ;; (which-key/stop-close-timer) ;; remove this because `which-key/show-popup' should be able to ;; handle the case where which-key buffer is already displayed ;; (which-key/hide-popup) @@ -155,8 +155,9 @@ Finally, show the buffer." (popup-act-dim (which-key/populate-buffer formatted-keys column-width (window-width)))) ;; show buffer - (when (which-key/show-popup popup-act-dim) - (which-key/start-close-timer)))) + (which-key/show-popup popup-act-dim))) + ;; (when (which-key/show-popup popup-act-dim) + ;; (which-key/start-close-timer)))) ;; command finished maybe close the window (which-key/hide-popup)))) commit 73d537454695d3a1f5fa6e90c1a3cede93516dae Merge: 1fd43dc7fb9 1cbad4b774b Author: Justin Burkett Date: Mon Jul 6 14:28:39 2015 -0400 Merge pull request #13 from bmag/pre-command-hook Hide buffer right before command execution commit 1fd43dc7fb929d6299dbdaddcf339057778eac69 Merge: 85f65a910da 35a171ef7dc Author: Justin Burkett Date: Mon Jul 6 14:23:56 2015 -0400 Merge branch 'frame-popup' of https://github.com/bmag/emacs-which-key into pr12 commit 85f65a910da32c34e5f4c1c96ed155a30a4ecad0 Author: Justin Burkett Date: Mon Jul 6 14:22:08 2015 -0400 Work on docstrings diff --git a/which-key.el b/which-key.el index a9149151f70..a3ba139e6d0 100644 --- a/which-key.el +++ b/which-key.el @@ -325,6 +325,9 @@ of the intended popup." (cons formatted (+ 4 max-len-key max-len-desc)))) (defun which-key/create-page (max-lines n-columns keys) + "Format KEYS into string representing a single page of text. +N-COLUMNS is the number of text columns to use and MAX-LINES is +the maximum number of lines availabel in the target buffer." (let* ((n-keys (length keys)) (n-lines (min (ceiling (/ (float n-keys) n-columns)) max-lines)) lines) @@ -366,9 +369,10 @@ of the intended popup." (cons act-height act-width))) (defun which-key/maybe-replace (text repl-alist &optional literal) - "Find and replace text in buffer according to REPLACEMENTS, -which is an alist where the car of each element is the text to -replace and the cdr is the replacement text." + "Perform replacements on TEXT. +REPL-ALIST is an alist where the car of each element is the text +to replace and the cdr is the replacement text. Unless LITERAL is +non-nil regexp is used in the replacements." (dolist (repl repl-alist) (setq text (if (string-match (car repl) text) @@ -385,8 +389,10 @@ replace and the cdr is the replacement text." (defun which-key/format-matches (unformatted max-len-key max-len-desc) "Turn each key-desc-cons in UNFORMATTED into formatted strings (including text properties), and pad with spaces so that -all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the -longest key and description in the buffer, respectively." +all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the +longest key and description in the buffer, respectively. +Replacements are performed using the key and description +replacement alists." (mapcar (lambda (key-desc-cons) (let* ((key (which-key/maybe-replace (car key-desc-cons) commit c8bf18a49bbe9c1afa262437391e4ec0549444c7 Author: Justin Burkett Date: Mon Jul 6 13:53:10 2015 -0400 Redo replacement logic diff --git a/which-key.el b/which-key.el index 5ae013d467f..a9149151f70 100644 --- a/which-key.el +++ b/which-key.el @@ -365,24 +365,16 @@ of the intended popup." (goto-char (point-min))))) (cons act-height act-width))) -(defun which-key/perform-replacements (key-desc-cons-list key-reps desc-reps &optional literal) +(defun which-key/maybe-replace (text repl-alist &optional literal) "Find and replace text in buffer according to REPLACEMENTS, which is an alist where the car of each element is the text to replace and the cdr is the replacement text." - (mapcar - (lambda (el) - (let ((key (car el)) (desc (cdr el))) - (dolist (key-rep key-reps) - (setq key - (if (string-match (car key-rep) key) - (replace-match (cdr key-rep) t literal key) - key))) - (dolist (desc-rep desc-reps) - (setq desc - (if (string-match (car desc-rep) desc) - (replace-match (cdr desc-rep) t literal desc) - desc))) - (cons key desc))) key-desc-cons-list)) + (dolist (repl repl-alist) + (setq text + (if (string-match (car repl) text) + (replace-match (cdr repl) t literal text) + text))) + text) (defsubst which-key/truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." @@ -395,13 +387,12 @@ replace and the cdr is the replacement text." strings (including text properties), and pad with spaces so that all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the longest key and description in the buffer, respectively." - (setq unformatted (which-key/perform-replacements - unformatted which-key-key-replacement-alist - which-key-description-replacement-alist nil)) (mapcar (lambda (key-desc-cons) - (let* ((key (car key-desc-cons)) - (desc (cdr key-desc-cons)) + (let* ((key (which-key/maybe-replace (car key-desc-cons) + which-key-key-replacement-alist)) + (desc (which-key/maybe-replace (cdr key-desc-cons) + which-key-description-replacement-alist)) (group (string-match-p "^group:" desc)) (desc (if group (substring desc 6) desc)) (prefix (string-match-p "^Prefix" desc)) commit eb6f52a0cbb1939d6294c1da9d5d37365e7779d3 Author: Justin Burkett Date: Mon Jul 6 13:40:49 2015 -0400 Make arrow separator into variable diff --git a/which-key.el b/which-key.el index 7571f7242c3..5ae013d467f 100644 --- a/which-key.el +++ b/which-key.el @@ -28,6 +28,8 @@ (defvar which-key-max-description-length 27 "Truncate the description of keys to this length. Also adds \"..\".") +(defvar which-key-separator "→" + "Separator to use between key and description.") (defvar which-key-key-replacement-alist '(("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") ("\\(left\\)" ."←") ("\\(right\\)" . "→")) @@ -406,14 +408,13 @@ longest key and description in the buffer, respectively." (desc (if (or prefix group) (concat "+" desc) desc)) (desc-face (if (or prefix group) 'font-lock-keyword-face 'font-lock-function-name-face)) - ;; (sign (if (or prefix group) "▶" "→")) - (sign "→") + (separator which-key-separator) (desc (which-key/truncate-description desc)) ;; pad keys to max-len-key (padded-key (s-pad-left max-len-key " " key)) (padded-desc (s-pad-right max-len-desc " " desc))) (format (concat (propertize "%s" 'face 'font-lock-constant-face) " " - (propertize sign 'face 'font-lock-comment-face) " " + (propertize separator 'face 'font-lock-comment-face) " " (propertize "%s" 'face desc-face) " ") padded-key padded-desc))) unformatted)) commit 9cec7b8e1d7738898c027850f70fe70d0862eaca Author: Justin Burkett Date: Mon Jul 6 13:23:19 2015 -0400 Refactor replacement alists diff --git a/which-key.el b/which-key.el index 7c7e16753ba..7571f7242c3 100644 --- a/which-key.el +++ b/which-key.el @@ -29,13 +29,14 @@ "Truncate the description of keys to this length. Also adds \"..\".") (defvar which-key-key-replacement-alist - '((">". "") ("<" . "") ("left" ."←") ("right" . "→")) - "The strings in the car of each cons cell are replaced with the + '(("<\\(\\(C-\\|M-\\)*.+\\)>" . "\\1") ("\\(left\\)" ."←") + ("\\(right\\)" . "→")) + "The strings in the car of each cons cell are replaced with the strings in the cdr for each key.") -(defvar which-key-general-replacement-alist +(defvar which-key-description-replacement-alist '(("Prefix Command" . "prefix")) "See `which-key-key-replacement-alist'. This is a list of cons -cells for replacing any text, keys and descriptions.") +cells for replacing descriptions.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-popup-type 'minibuffer @@ -303,14 +304,12 @@ of the intended popup." key-match desc-match unformatted formatted) (with-temp-buffer (describe-buffer-bindings buffer key) - (which-key/replace-strings-from-alist which-key-general-replacement-alist) (goto-char (point-max)) ; want to put last keys in first (while (re-search-backward (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt) nil t) - (setq key-match (s-replace-all - which-key-key-replacement-alist (match-string 1)) + (setq key-match (match-string 1) desc-match (match-string 2) max-len-key (max max-len-key (length key-match)) max-len-desc (max max-len-desc (length desc-match))) @@ -364,15 +363,24 @@ of the intended popup." (goto-char (point-min))))) (cons act-height act-width))) -(defun which-key/replace-strings-from-alist (replacements) +(defun which-key/perform-replacements (key-desc-cons-list key-reps desc-reps &optional literal) "Find and replace text in buffer according to REPLACEMENTS, which is an alist where the car of each element is the text to replace and the cdr is the replacement text." - (dolist (rep replacements) - (save-excursion - (goto-char (point-min)) - (while (or (search-forward (car rep) nil t)) - (replace-match (cdr rep) t t))))) + (mapcar + (lambda (el) + (let ((key (car el)) (desc (cdr el))) + (dolist (key-rep key-reps) + (setq key + (if (string-match (car key-rep) key) + (replace-match (cdr key-rep) t literal key) + key))) + (dolist (desc-rep desc-reps) + (setq desc + (if (string-match (car desc-rep) desc) + (replace-match (cdr desc-rep) t literal desc) + desc))) + (cons key desc))) key-desc-cons-list)) (defsubst which-key/truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." @@ -385,6 +393,9 @@ replace and the cdr is the replacement text." strings (including text properties), and pad with spaces so that all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the longest key and description in the buffer, respectively." + (setq unformatted (which-key/perform-replacements + unformatted which-key-key-replacement-alist + which-key-description-replacement-alist nil)) (mapcar (lambda (key-desc-cons) (let* ((key (car key-desc-cons)) commit 1cbad4b774bd25f3b19b96d3639434490c9b4261 Author: Bar Magal Date: Mon Jul 6 19:34:31 2015 +0300 Hide buffer right before command execution Fixes #9, this is also what guide-key uses. When quoting functions, using "#'" tells the compiler that you're quoting a function, and allows it to catch void function errors. diff --git a/which-key.el b/which-key.el index 7c7e16753ba..4f1e8c23440 100644 --- a/which-key.el +++ b/which-key.el @@ -81,17 +81,19 @@ Used when `which-key-popup-type' is frame.") (progn (unless which-key--setup-p (which-key/setup)) ;; make echo-keytrokes fast for minibuffer popup - ;; (it can interfer if it's too slow) + ;; (it can interfer if it's too slow) (when (and (> echo-keystrokes 0) - (eq which-key-popup-type 'minibuffer)) - (setq echo-keystrokes 0.1)) - (add-hook 'focus-out-hook 'which-key/stop-open-timer) - (add-hook 'focus-in-hook 'which-key/start-open-timer) + (eq which-key-popup-type 'minibuffer)) + (setq echo-keystrokes 0.1)) + (add-hook 'pre-command-hook #'which-key/hide-popup) + (add-hook 'focus-out-hook #'which-key/stop-open-timer) + (add-hook 'focus-in-hook #'which-key/start-open-timer) (which-key/start-open-timer)) ;; make sure echo-keystrokes returns to original value (setq echo-keystrokes which-key--echo-keystrokes-backup) - (remove-hook 'focus-out-hook 'which-key/stop-open-timer) - (remove-hook 'focus-in-hook 'which-key/start-open-timer) + (remove-hook 'pre-command-hook #'which-key/hide-popup) + (remove-hook 'focus-out-hook #'which-key/stop-open-timer) + (remove-hook 'focus-in-hook #'which-key/start-open-timer) (which-key/stop-open-timer) (which-key/stop-close-timer))) commit 35a171ef7dc72f33460988fa0c64ae8106bbb717 Author: Bar Magal Date: Mon Jul 6 19:22:40 2015 +0300 Try to fix focus problems with popup frame #7 diff --git a/which-key.el b/which-key.el index 7c7e16753ba..efc536f46f9 100644 --- a/which-key.el +++ b/which-key.el @@ -220,31 +220,58 @@ need to start the closing timer." (display-buffer-in-major-side-window which-key--buffer side 0 alist)))) (defun which-key/show-buffer-frame (act-popup-dim) - (let ((orig-window (selected-window)) + (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) - (which-key/show-buffer-new-frame act-popup-dim)))) - (fit-frame-to-buffer (window-frame new-window)) - (select-frame-set-input-focus (window-frame orig-window)) - (select-window orig-window) - (setq which-key--frame (window-frame new-window)) - new-window)) - -(defun which-key/show-buffer-new-frame (act-popup-dim) - (let* ((height (car act-popup-dim)) - (width (cdr act-popup-dim)) - (frame-params (delq nil (list (when (and height width) (cons 'height height)) - (when (and height width) (cons 'width width)) - (cons 'minibuffer nil) - (cons 'name "which-key")))) - (alist (list (cons 'pop-up-frame-parameters frame-params) - (cons 'inhibit-switch-frame t)))) - (display-buffer-pop-up-frame which-key--buffer alist))) - -(defun which-key/show-buffer-reuse-frame () - (display-buffer-reuse-window which-key--buffer `((reusable-frames . ,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) + (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) + (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))) ;; Keep for popwin maybe (Used to work) ;; (defun which-key/show-buffer-popwin (height width) commit 163eacfa9d78bdebec83337031a56acc57dea168 Author: Justin Burkett Date: Mon Jul 6 11:18:55 2015 -0400 Allow echo-keystrokes but make it quick diff --git a/.gitignore b/.gitignore index 3853c61a77d..34da34edea6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ +*~ # Used to setup library paths for emacs -Q -private-test-setup.el \ No newline at end of file +private-test-setup.el diff --git a/which-key.el b/which-key.el index 37a6e234496..7c7e16753ba 100644 --- a/which-key.el +++ b/which-key.el @@ -80,8 +80,11 @@ Used when `which-key-popup-type' is frame.") (if which-key-mode (progn (unless which-key--setup-p (which-key/setup)) - ;; turn off echo-keytrokes for minibuffer (it can interfer) - (when (eq which-key-popup-type 'minibuffer) (setq echo-keystrokes 0)) + ;; make echo-keytrokes fast for minibuffer popup + ;; (it can interfer if it's too slow) + (when (and (> echo-keystrokes 0) + (eq which-key-popup-type 'minibuffer)) + (setq echo-keystrokes 0.1)) (add-hook 'focus-out-hook 'which-key/stop-open-timer) (add-hook 'focus-in-hook 'which-key/start-open-timer) (which-key/start-open-timer)) @@ -344,7 +347,7 @@ of the intended popup." (n-pages (if max-keys/page (ceiling (/ (float n-keys) max-keys/page)) 1)) pages act-height) - (when (> n-columns 0) + (when (and (> n-keys 0) (> n-columns 0)) (dotimes (p n-pages) (setq pages (push (which-key/create-page max-height n-columns commit 3119e80c3e6294ee9990b8aa00fb4251c58ef70e Author: Justin Burkett Date: Mon Jul 6 11:03:00 2015 -0400 Add .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000000..3853c61a77d --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +# Used to setup library paths for emacs -Q +private-test-setup.el \ No newline at end of file commit a760c589db0f4ed13dd4efefaa641f836cfc64b9 Author: Justin Burkett Date: Mon Jul 6 10:54:24 2015 -0400 Fix problem with echo-keystrokes and minibuffer If the echo-keystrokes delay is too long, it clobbers which-key in the minibuffer diff --git a/which-key.el b/which-key.el index 97393af9c0b..37a6e234496 100644 --- a/which-key.el +++ b/which-key.el @@ -69,6 +69,8 @@ location is top or bottom.") (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 echo-keystrokes + "Internal: Backup the initial value of echo-keystrokes.") ;;;###autoload (define-minor-mode which-key-mode @@ -78,9 +80,13 @@ Used when `which-key-popup-type' is frame.") (if which-key-mode (progn (unless which-key--setup-p (which-key/setup)) + ;; turn off echo-keytrokes for minibuffer (it can interfer) + (when (eq which-key-popup-type 'minibuffer) (setq echo-keystrokes 0)) (add-hook 'focus-out-hook 'which-key/stop-open-timer) (add-hook 'focus-in-hook 'which-key/start-open-timer) (which-key/start-open-timer)) + ;; make sure echo-keystrokes returns to original value + (setq echo-keystrokes which-key--echo-keystrokes-backup) (remove-hook 'focus-out-hook 'which-key/stop-open-timer) (remove-hook 'focus-in-hook 'which-key/start-open-timer) (which-key/stop-open-timer) commit c551775370435ad59d7539f3c9816339235054d2 Author: Justin Burkett Date: Mon Jul 6 09:48:56 2015 -0400 Remove popwin requirement; Add require cl diff --git a/which-key.el b/which-key.el index 06bf29815e4..97393af9c0b 100644 --- a/which-key.el +++ b/which-key.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/justbur/which-key/ ;; Version: 0.1 ;; Keywords: -;; Package-Requires: ((emacs "24.3") (s "1.9.0") (popwin "1.0.0")) +;; Package-Requires: ((emacs "24.3") (s "1.9.0")) ;;; Commentary: ;; @@ -55,7 +55,7 @@ location is top or bottom.") "Maximum height of which-key popup when type is frame.") ;; Internal Vars -(defvar popwin:popup-buffer nil) +;; (defvar popwin:popup-buffer nil) (defvar which-key--buffer nil "Internal: Holds reference to which-key buffer.") (defvar which-key--window nil @@ -88,8 +88,9 @@ Used when `which-key-popup-type' is frame.") (defun which-key/setup () "Create buffer for which-key." + (require 'cl) (require 's) - (require 'popwin) +;; (require 'popwin) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (with-current-buffer which-key--buffer (setq-local cursor-type nil) commit 38362826cf3cf161b47ad95b145a89b4b864b2c3 Merge: a1aa345111f 44450f60c7f Author: Justin Burkett Date: Mon Jul 6 08:08:32 2015 -0400 Merge branch 'master' of https://github.com/bmag/emacs-which-key into pr5 commit a1aa345111fafc3bd78ff4b19bb3cd279e51f835 Author: Justin Burkett Date: Mon Jul 6 08:03:59 2015 -0400 Delete old defvars and minor docstring cleanup diff --git a/which-key.el b/which-key.el index 0230aad242d..d0cd142fbff 100644 --- a/which-key.el +++ b/which-key.el @@ -39,7 +39,7 @@ cells for replacing any text, keys and descriptions.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-popup-type 'minibuffer - "Supported types are minibuffer and side-window.") + "Supported types are minibuffer, side-window and frame.") (defvar 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.") @@ -53,17 +53,6 @@ location is top or bottom.") "Maximum width of which-key popup when type is frame.") (defvar which-key-frame-max-height 20 "Maximum height of which-key popup when type is frame.") -;; (defvar which-key-display-method 'minibuffer -;; "Controls the method used to display the keys. The default is -;; minibuffer, but other possibilities are 'popwin and -;; 'display-buffer. You will also be able write your own display -;; function (not implemented yet).") - -;; (defconst which-key-buffer-display-function -;; 'display-buffer-in-side-window -;; "Controls where the buffer is displayed. The current default is -;; also controlled by `which-key-side-window-location'. Other options are -;; currently disabled.") ;; Internal Vars (defvar popwin:popup-buffer nil) @@ -79,7 +68,7 @@ location is top or bottom.") "Internal: Non-nil if which-key buffer has been setup.") (defvar which-key--frame nil "Internal: Holds reference to which-key frame. -Used when `which-key-popup-type' is 'popup.") +Used when `which-key-popup-type' is frame.") ;;;###autoload (define-minor-mode which-key-mode commit 44450f60c7f855ceb23529eb449db299b59b8755 Author: Bar Magal Date: Mon Jul 6 14:51:31 2015 +0300 Fix doc, new frame parameters diff --git a/which-key.el b/which-key.el index 0230aad242d..6583664a2d9 100644 --- a/which-key.el +++ b/which-key.el @@ -79,7 +79,7 @@ location is top or bottom.") "Internal: Non-nil if which-key buffer has been setup.") (defvar which-key--frame nil "Internal: Holds reference to which-key frame. -Used when `which-key-popup-type' is 'popup.") +Used when `which-key-popup-type' is frame.") ;;;###autoload (define-minor-mode which-key-mode @@ -236,8 +236,8 @@ need to start the closing timer." (defun which-key/show-buffer-new-frame (act-popup-dim) (let* ((height (car act-popup-dim)) (width (cdr act-popup-dim)) - (frame-params (delq nil (list (when (and height width) (cons 'window-height height)) - (when (and height width) (cons 'window-width width)) + (frame-params (delq nil (list (when (and height width) (cons 'height height)) + (when (and height width) (cons 'width width)) (cons 'minibuffer nil) (cons 'name "which-key")))) (alist (list (cons 'pop-up-frame-parameters frame-params) commit 02140265c42cc3f4793bfcd05ee6c5165ecd4b2c Author: Bar Magal Date: Mon Jul 6 13:46:46 2015 +0300 Frame popup support and some small fixes Summary of changes: - add emacs 24.3 as a dependency, because `display-buffer-in-major-side-window` doesn't exist in older emacsen - add option to show which-key buffer in a popup frame `(setq which-key-popup-type 'frame)` - stop close timer when disabling which-key-mode - don't hide which-key buffer before showing it. instead, show methods handle the case that the buffer is already shown - `which-key/hide-popup` calls function depending on popup type (similar to `which-key/show-popup`) - use `display-buffer-in-major-side-window` instead of `display-buffer-in-side-window`, for popup type side-window. ensures new side window is created properly even if other side windows already exist. - erase previous contents of which-key buffer before inserting new contents, and adjust buffer display in window by moving point to the buffer's beginning diff --git a/which-key.el b/which-key.el index 5a03fcbc846..0230aad242d 100644 --- a/which-key.el +++ b/which-key.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/justbur/which-key/ ;; Version: 0.1 ;; Keywords: -;; Package-Requires: ((s "1.9.0") (popwin "1.0.0")) +;; Package-Requires: ((emacs "24.3") (s "1.9.0") (popwin "1.0.0")) ;;; Commentary: ;; @@ -49,6 +49,10 @@ location is left or right.") (defvar which-key-side-window-max-height 20 "Maximum height of which-key popup when type is side-window and location is top or bottom.") +(defvar which-key-frame-max-width 60 + "Maximum width of which-key popup when type is frame.") +(defvar which-key-frame-max-height 20 + "Maximum height of which-key popup when type is frame.") ;; (defvar which-key-display-method 'minibuffer ;; "Controls the method used to display the keys. The default is ;; minibuffer, but other possibilities are 'popwin and @@ -73,6 +77,9 @@ location is top or bottom.") "Internal: Holds reference to close window timer.") (defvar which-key--setup-p nil "Internal: Non-nil if which-key buffer has been setup.") +(defvar which-key--frame nil + "Internal: Holds reference to which-key frame. +Used when `which-key-popup-type' is 'popup.") ;;;###autoload (define-minor-mode which-key-mode @@ -87,7 +94,8 @@ location is top or bottom.") (which-key/start-open-timer)) (remove-hook 'focus-out-hook 'which-key/stop-open-timer) (remove-hook 'focus-in-hook 'which-key/start-open-timer) - (which-key/stop-open-timer))) + (which-key/stop-open-timer) + (which-key/stop-close-timer))) (defun which-key/setup () "Create buffer for which-key." @@ -131,7 +139,9 @@ Finally, show the buffer." (if (> (length key) 0) (progn (which-key/stop-close-timer) - (which-key/hide-popup) + ;; remove this because `which-key/show-popup' should be able to + ;; handle the case where which-key buffer is already displayed + ;; (which-key/hide-popup) (let* ((buf (current-buffer)) ;; get formatted key bindings (fmt-width-cons (which-key/get-formatted-key-bindings buf key)) @@ -154,8 +164,23 @@ Finally, show the buffer." ;; (delete-window which-key--window))) (defun which-key/hide-popup () + (cl-case which-key-popup-type + (minibuffer (which-key/hide-buffer-minibuffer)) + (side-window (which-key/hide-buffer-side-window)) + (frame (which-key/hide-buffer-frame)))) + +(defun which-key/hide-buffer-minibuffer () + nil) + +(defun which-key/hide-buffer-side-window () (when (buffer-live-p which-key--buffer) - (delete-windows-on 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 () + (when (frame-live-p which-key--frame) + (delete-frame which-key--frame))) (defun which-key/show-popup (act-popup-dim) "Show guide window. ACT-POPUP-DIM includes the @@ -164,7 +189,8 @@ in the popup. Return nil if no window is shown, or if there is no need to start the closing timer." (cl-case which-key-popup-type (minibuffer (which-key/show-buffer-minibuffer act-popup-dim)) - (side-window (which-key/show-buffer-side-window act-popup-dim)))) + (side-window (which-key/show-buffer-side-window act-popup-dim)) + (frame (which-key/show-buffer-frame act-popup-dim)))) (defun which-key/show-buffer-minibuffer (act-popup-dim) nil) @@ -173,10 +199,53 @@ need to start the closing timer." (let* ((height (car act-popup-dim)) (width (cdr act-popup-dim)) (side which-key-side-window-location) - (alist (delq nil (list (when side (cons 'side side)) - (when height (cons 'window-height height)) + (alist (delq nil (list (when height (cons 'window-height height)) (when width (cons 'window-width width)))))) - (display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist)))) + ;; Note: `display-buffer-in-side-window' and `display-buffer-in-major-side-window' + ;; were added in Emacs 24.3 + + ;; If two side windows exist in the same side, `display-buffer-in-side-window' + ;; will use on of them, which isn't desirable. `display-buffer-in-major-side-window' + ;; will pop a new window, so we use that. + ;; +-------------------------+ +-------------------------+ + ;; | regular window | | regular window | + ;; | | +------------+------------+ + ;; +------------+------------+ --> | side-win 1 | side-win 2 | + ;; | side-win 1 | side-win 2 | |------------+------------| + ;; | | | | which-key window | + ;; +------------+------------+ +------------+------------+ + ;; (display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist)) + ;; side defaults to bottom + (if (get-buffer-window which-key--buffer) + (display-buffer-reuse-window which-key--buffer alist) + (display-buffer-in-major-side-window which-key--buffer side 0 alist)))) + +(defun which-key/show-buffer-frame (act-popup-dim) + (let ((orig-window (selected-window)) + (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) + (which-key/show-buffer-new-frame act-popup-dim)))) + (fit-frame-to-buffer (window-frame new-window)) + (select-frame-set-input-focus (window-frame orig-window)) + (select-window orig-window) + (setq which-key--frame (window-frame new-window)) + new-window)) + +(defun which-key/show-buffer-new-frame (act-popup-dim) + (let* ((height (car act-popup-dim)) + (width (cdr act-popup-dim)) + (frame-params (delq nil (list (when (and height width) (cons 'window-height height)) + (when (and height width) (cons 'window-width width)) + (cons 'minibuffer nil) + (cons 'name "which-key")))) + (alist (list (cons 'pop-up-frame-parameters frame-params) + (cons 'inhibit-switch-frame t)))) + (display-buffer-pop-up-frame which-key--buffer alist))) + +(defun which-key/show-buffer-reuse-frame () + (display-buffer-reuse-window which-key--buffer `((reusable-frames . ,which-key--frame)))) ;; Keep for popwin maybe (Used to work) ;; (defun which-key/show-buffer-popwin (height width) @@ -199,7 +268,8 @@ need to start the closing timer." of the intended popup." (cl-case which-key-popup-type (minibuffer (which-key/minibuffer-max-dimensions)) - (side-window (which-key/side-window-max-dimensions column-width)))) + (side-window (which-key/side-window-max-dimensions column-width)) + (frame (which-key/frame-max-dimensions)))) (defun which-key/minibuffer-max-dimensions () (cons @@ -223,6 +293,9 @@ of the intended popup." (min which-key-side-window-max-width column-width) (frame-width)))) +(defun which-key/frame-max-dimensions () + (cons which-key-frame-max-height which-key-frame-max-width)) + ;; Buffer contents functions (defun which-key/get-formatted-key-bindings (buffer key) @@ -287,7 +360,9 @@ of the intended popup." (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" (car pages))) (with-current-buffer which-key--buffer - (insert (car pages))))) + (erase-buffer) + (insert (car pages)) + (goto-char (point-min))))) (cons act-height act-width))) (defun which-key/replace-strings-from-alist (replacements) commit 20353a292366d5bbd16f90fe0480f00b26f1fdc7 Author: Justin Burkett Date: Sun Jul 5 23:02:31 2015 -0400 Rename config variables, simplifying interface The primary config variable is now which-key-popup-type, which supports 'minibuffer and 'side-window. 'side-window has further associated options, primarily which-key-side-window-location diff --git a/which-key.el b/which-key.el index 7f6af2a10b3..5a03fcbc846 100644 --- a/which-key.el +++ b/which-key.el @@ -38,23 +38,28 @@ strings in the cdr for each key.") cells for replacing any text, keys and descriptions.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") -(defvar which-key-buffer-position 'bottom - "Position of which-key buffer.") -(defvar which-key-vertical-buffer-width 60 - "Width of which-key buffer.") -(defvar which-key-horizontal-buffer-height 20 - "Height of which-key buffer.") -(defvar which-key-display-method 'minibuffer - "Controls the method used to display the keys. The default is -minibuffer, but other possibilities are 'popwin and -'display-buffer. You will also be able write your own display -function (not implemented yet).") - -(defconst which-key-buffer-display-function - 'display-buffer-in-side-window - "Controls where the buffer is displayed. The current default is -also controlled by `which-key-buffer-position'. Other options are -currently disabled.") +(defvar which-key-popup-type 'minibuffer + "Supported types are minibuffer and side-window.") +(defvar 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.") +(defvar which-key-side-window-max-width 60 + "Maximum width of which-key popup when type is side-window and +location is left or right.") +(defvar which-key-side-window-max-height 20 + "Maximum height of which-key popup when type is side-window and +location is top or bottom.") +;; (defvar which-key-display-method 'minibuffer +;; "Controls the method used to display the keys. The default is +;; minibuffer, but other possibilities are 'popwin and +;; 'display-buffer. You will also be able write your own display +;; function (not implemented yet).") + +;; (defconst which-key-buffer-display-function +;; 'display-buffer-in-side-window +;; "Controls where the buffer is displayed. The current default is +;; also controlled by `which-key-side-window-location'. Other options are +;; currently disabled.") ;; Internal Vars (defvar popwin:popup-buffer nil) @@ -111,7 +116,7 @@ currently disabled.") (which-key/stop-close-timer) ; start over (setq which-key--close-timer (run-at-time which-key-close-buffer-idle-delay - nil 'which-key/hide-buffer))) + nil 'which-key/hide-popup))) (defun which-key/stop-close-timer () "Deactivate idle timer." @@ -126,21 +131,20 @@ Finally, show the buffer." (if (> (length key) 0) (progn (which-key/stop-close-timer) - (which-key/hide-buffer) + (which-key/hide-popup) (let* ((buf (current-buffer)) - ;; (bottom-or-top (member which-key-buffer-position '(top bottom))) ;; get formatted key bindings (fmt-width-cons (which-key/get-formatted-key-bindings buf key)) (formatted-keys (car fmt-width-cons)) (column-width (cdr fmt-width-cons)) - (buffer-width (which-key/buffer-width column-width (window-width))) ;; populate target buffer - (n-lines (which-key/populate-buffer formatted-keys column-width buffer-width))) + (popup-act-dim + (which-key/populate-buffer formatted-keys column-width (window-width)))) ;; show buffer - (when (which-key/show-buffer n-lines buffer-width) + (when (which-key/show-popup popup-act-dim) (which-key/start-close-timer)))) ;; command finished maybe close the window - (which-key/hide-buffer)))) + (which-key/hide-popup)))) ;; Show/hide guide buffer @@ -149,23 +153,26 @@ Finally, show the buffer." ;; (when (window-live-p which-key--window) ;; (delete-window which-key--window))) -(defun which-key/hide-buffer () +(defun which-key/hide-popup () (when (buffer-live-p which-key--buffer) (delete-windows-on which-key--buffer))) -(defun which-key/show-buffer (height width) - "Show guide window. -Return nil if no window is shown, or if there is no need to start the -closing timer." - (cl-case which-key-display-method - (minibuffer (which-key/show-buffer-minibuffer height width)) - (side-window (which-key/show-buffer-side-window height width)))) +(defun which-key/show-popup (act-popup-dim) + "Show guide window. 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." + (cl-case which-key-popup-type + (minibuffer (which-key/show-buffer-minibuffer act-popup-dim)) + (side-window (which-key/show-buffer-side-window act-popup-dim)))) -(defun which-key/show-buffer-minibuffer (height width) +(defun which-key/show-buffer-minibuffer (act-popup-dim) nil) -(defun which-key/show-buffer-side-window (height width) - (let* ((side which-key-buffer-position) +(defun which-key/show-buffer-side-window (act-popup-dim) + (let* ((height (car act-popup-dim)) + (width (cdr act-popup-dim)) + (side which-key-side-window-location) (alist (delq nil (list (when side (cons 'side side)) (when height (cons 'window-height height)) (when width (cons 'window-width width)))))) @@ -178,7 +185,7 @@ closing timer." ;; :height height ;; :width width ;; :noselect t -;; :position which-key-buffer-position)) +;; :position which-key-side-window-location)) ;; (defun which-key/hide-buffer-popwin () ;; "Hide popwin buffer." @@ -187,44 +194,34 @@ closing timer." ;; Size functions -(defun which-key/buffer-width (column-width sel-window-width) - (cl-case which-key-display-method - (minibuffer (which-key/buffer-width-minibuffer column-width sel-window-width)) - (side-window (which-key/buffer-width-side-window column-width sel-window-width)))) - -(defun which-key/buffer-width-minibuffer (column-width sel-window-width) - (frame-text-cols)) - -(defun which-key/buffer-width-side-window (column-width sel-window-width) - (if (member which-key-buffer-position '(left right)) - (min which-key-vertical-buffer-width column-width) - (frame-width))) - -;; (defun which-key/available-lines () -;; "Only works for minibuffer right now." -;; (when (eq which-key-display-method 'minibuffer) -;; (if (floatp max-mini-window-height) -;; (floor (* (frame-text-lines) -;; max-mini-window-height)) -;; max-mini-window-height))) - -(defun which-key/available-lines () - (cl-case which-key-display-method - (minibuffer (which-key/available-lines-minibuffer)) - (side-window (which-key/available-lines-side-window)))) - -(defun which-key/available-lines-minibuffer () - "Only works for minibuffer right now." - (if (floatp max-mini-window-height) - (floor (* (frame-text-lines) - max-mini-window-height)) - max-mini-window-height)) - -(defun which-key/available-lines-side-window () - (if (member which-key-buffer-position '(left right)) - (frame-height) - ;; FIXME: change to something like (min which-*-height (calculate-max-height)) - which-key-horizontal-buffer-height)) +(defun which-key/popup-max-dimensions (column-width selected-window-width) + "Dimesion functions should return the maximum possible (height . width) +of the intended popup." + (cl-case which-key-popup-type + (minibuffer (which-key/minibuffer-max-dimensions)) + (side-window (which-key/side-window-max-dimensions column-width)))) + +(defun which-key/minibuffer-max-dimensions () + (cons + ;; height + (if (floatp max-mini-window-height) + (floor (* (frame-text-lines) + max-mini-window-height)) + max-mini-window-height) + ;; width + (frame-text-cols))) + +(defun which-key/side-window-max-dimensions (column-width) + (cons + ;; height + (if (member which-key-side-window-location '(left right)) + (frame-height) + ;; FIXME: change to something like (min which-*-height (calculate-max-height)) + which-key-side-window-max-height) + ;; width + (if (member which-key-side-window-location '(left right)) + (min which-key-side-window-max-width column-width) + (frame-width)))) ;; Buffer contents functions @@ -254,10 +251,10 @@ closing timer." unformatted max-len-key max-len-desc))) (cons formatted (+ 4 max-len-key max-len-desc)))) -(defun which-key/create-page (avl-lines n-columns keys) - (let (lines - (n-keys (length keys)) - (n-lines (min (ceiling (/ (float n-keys) n-columns)) avl-lines))) +(defun which-key/create-page (max-lines n-columns keys) + (let* ((n-keys (length keys)) + (n-lines (min (ceiling (/ (float n-keys) n-columns)) max-lines)) + lines) (dotimes (i n-lines) (setq lines (push @@ -265,28 +262,33 @@ closing timer." lines))) (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n"))) -(defun which-key/populate-buffer (formatted-keys column-width buffer-width) +(defun which-key/populate-buffer (formatted-keys column-width sel-win-width) "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." - (let* ((width (if buffer-width buffer-width (frame-text-width))) - (n-keys (length formatted-keys)) - (n-columns (/ width column-width)) ;; integer division - (avl-lines/page (which-key/available-lines)) - (n-keys/page (when avl-lines/page (* n-columns avl-lines/page))) - (n-pages (if n-keys/page - (ceiling (/ (float n-keys) n-keys/page)) 1)) - lines pages n-lines ) + (let* ((n-keys (length formatted-keys)) + (max-dims (which-key/popup-max-dimensions column-width sel-win-width)) + (max-height (when (car max-dims) (car max-dims))) + (max-width (when (cdr max-dims) (cdr max-dims))) + (n-columns (/ max-width column-width)) ;; integer division + (act-width (* n-columns column-width)) + ;; (avl-lines/page (which-key/available-lines)) + (max-keys/page (when max-height (* n-columns max-height))) + (n-pages (if max-keys/page + (ceiling (/ (float n-keys) max-keys/page)) 1)) + pages act-height) (when (> n-columns 0) (dotimes (p n-pages) (setq pages - (push (which-key/create-page avl-lines/page n-columns - (subseq formatted-keys (* p n-keys/page) - (min (* (1+ p) n-keys/page) n-keys))) pages))) - (setq pages (reverse pages)) - (if (eq which-key-display-method 'minibuffer) + (push (which-key/create-page max-height n-columns + (subseq formatted-keys (* p max-keys/page) + (min (* (1+ p) max-keys/page) n-keys))) pages))) + ;; not doing anything with other pages for now + (setq pages (reverse pages) + act-height (1+ (s-count-matches "\n" (car pages)))) + (if (eq which-key-popup-type 'minibuffer) (let (message-log-max) (message "%s" (car pages))) (with-current-buffer which-key--buffer (insert (car pages))))) - n-lines)) + (cons act-height act-width))) (defun which-key/replace-strings-from-alist (replacements) "Find and replace text in buffer according to REPLACEMENTS, @@ -298,6 +300,12 @@ replace and the cdr is the replacement text." (while (or (search-forward (car rep) nil t)) (replace-match (cdr rep) t t))))) +(defsubst which-key/truncate-description (desc) + "Truncate DESC description to `which-key-max-description-length'." + (if (> (length desc) which-key-max-description-length) + (concat (substring desc 0 which-key-max-description-length) "..") + desc)) + (defun which-key/format-matches (unformatted max-len-key max-len-desc) "Turn each key-desc-cons in UNFORMATTED into formatted strings (including text properties), and pad with spaces so that @@ -325,12 +333,6 @@ longest key and description in the buffer, respectively." padded-key padded-desc))) unformatted)) -(defsubst which-key/truncate-description (desc) - "Truncate DESC description to `which-key-max-description-length'." - (if (> (length desc) which-key-max-description-length) - (concat (substring desc 0 which-key-max-description-length) "..") - desc)) - (provide 'which-key) ;;; which-key.el ends here commit ab3ff4770fd5c9be7c647601e3863bd43b5dcf6b Merge: da0f7e1cd1d 963944cbf60 Author: Justin Burkett Date: Sun Jul 5 19:24:20 2015 -0400 Merge bmag changes See PR #1 commit da0f7e1cd1d0ab6d070a4f3c7248a779c682ffb6 Author: Justin Burkett Date: Sun Jul 5 13:55:19 2015 -0400 Organize keys by pages diff --git a/which-key.el b/which-key.el index 898c12e52d0..b8b77dada90 100644 --- a/which-key.el +++ b/which-key.el @@ -101,7 +101,7 @@ currently disabled.") (concat (substring desc 0 which-key-max-description-length) "..") desc)) -(defun which-key/available-lines () +(defun which-key/available-lines-per-page () "Only works for minibuffer right now." (when (eq which-key-display-method 'minibuffer) (if (floatp max-mini-window-height) @@ -189,25 +189,37 @@ longest key and description in the buffer, respectively." unformatted max-len-key max-len-desc))) (cons formatted (+ 4 max-len-key max-len-desc)))) +(defun which-key/create-page (avl-lines n-columns keys) + (let (lines + (n-keys (length keys)) + (n-lines (min (ceiling (/ (float n-keys) n-columns)) avl-lines))) + (dotimes (i n-lines) + (setq lines + (push + (subseq keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) + lines))) + (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n"))) + (defun which-key/populate-buffer (formatted-keys column-width buffer-width) - "Insert FORMATTED-STRINGS into buffer, breaking after BUFFER-WIDTH." - (let* ((char-count 0) (line-breaks 0) (this-column 1) - (width (if buffer-width buffer-width (frame-text-width))) + "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH." + (let* ((width (if buffer-width buffer-width (frame-text-width))) (n-keys (length formatted-keys)) (n-columns (/ width column-width)) ;; integer division - (n-lines (which-key/available-lines)) - (max-lines (ceiling (/ (float n-keys) n-columns))) - (n-lines (if n-lines (min n-lines max-lines) max-lines)) - lines str-to-insert start end) + (avl-lines/page (which-key/available-lines-per-page)) + (n-keys/page (when avl-lines/page (* n-columns avl-lines/page))) + (n-pages (if n-keys/page + (ceiling (/ (float n-keys) n-keys/page)) 1)) + lines pages n-lines ) (when (> n-columns 0) - (dotimes (i n-lines) - (setq lines - (push (subseq formatted-keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) - lines))) - (setq str-to-insert (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n")) + (dotimes (p n-pages) + (setq pages + (push (which-key/create-page avl-lines/page n-columns + (subseq formatted-keys (* p n-keys/page) + (min (* (1+ p) n-keys/page) n-keys))) pages))) + (setq pages (reverse pages)) (if (eq which-key-display-method 'minibuffer) - (let (message-log-max) (message "%s" str-to-insert)) - (insert str-to-insert))) + (let (message-log-max) (message "%s" (car pages))) + (insert (car pages)))) n-lines)) (defun which-key/update () @@ -250,6 +262,9 @@ Finally, show the buffer." "Deactivate idle timer." (cancel-timer which-key--open-timer)) +;; placeholder for page flipping +;; (defun which-key/start-next-page-timer ()) + ;; Display functions (defun which-key/show-buffer-display-buffer (height width) commit 963944cbf60c79a450559489c38d1ba0abba197d Author: Bar Magal Date: Sun Jul 5 23:26:47 2015 +0300 Undo unintentional delete of end-of-file comment diff --git a/which-key.el b/which-key.el index 30a83b50604..c41af8b6a65 100644 --- a/which-key.el +++ b/which-key.el @@ -293,3 +293,5 @@ longest key and description in the buffer, respectively." desc)) (provide 'which-key) + +;;; which-key.el ends here commit 1812df66954e9190e9615c7a752f929404fc5eaf Author: Bar Magal Date: Sun Jul 5 23:24:31 2015 +0300 Undo unintentional delete of provide line diff --git a/which-key.el b/which-key.el index 59caa12ca51..30a83b50604 100644 --- a/which-key.el +++ b/which-key.el @@ -291,3 +291,5 @@ longest key and description in the buffer, respectively." (if (> (length desc) which-key-max-description-length) (concat (substring desc 0 which-key-max-description-length) "..") desc)) + +(provide 'which-key) commit 67065197d340a24280b97cf7f6d49899f7ef42d8 Author: Bar Magal Date: Sun Jul 5 23:10:01 2015 +0300 Refactor before work on window display Wanted to add support for using display-buffer or popwin, ran into some bugs, had to make changes to the code so future work will be easier. Details below: - separate between code to display window and code to populate buffer contents - add `which-key-horizontal-buffer-height` similar to `which-key-vertical-buffer-width` - abstract handling of different display methods into `which-key/show-buffer` and `which-key/hide-buffer`, instead of mixed in other functions - remove `which-key/make-display-method-aliases` - support two display methods: `minibuffer` and `side-window`, will add popwin later - create start/stop functions for which-key--close-timer - a few other changes diff --git a/which-key.el b/which-key.el index 898c12e52d0..59caa12ca51 100644 --- a/which-key.el +++ b/which-key.el @@ -41,7 +41,9 @@ cells for replacing any text, keys and descriptions.") (defvar which-key-buffer-position 'bottom "Position of which-key buffer.") (defvar which-key-vertical-buffer-width 60 - "Width of which-key buffer .") + "Width of which-key buffer.") +(defvar which-key-horizontal-buffer-height 20 + "Height of which-key buffer.") (defvar which-key-display-method 'minibuffer "Controls the method used to display the keys. The default is minibuffer, but other possibilities are 'popwin and @@ -72,16 +74,15 @@ currently disabled.") "Toggle which-key-mode." :global t :lighter " WK" - (if which-key-mode - (progn - (unless which-key--setup-p (which-key/setup)) - (add-hook 'focus-out-hook 'which-key/stop-open-timer) - (add-hook 'focus-in-hook 'which-key/start-open-timer) - (which-key/make-display-method-aliases which-key-display-method) - (which-key/start-open-timer)) - (remove-hook 'focus-out-hook 'which-key/stop-open-timer) - (remove-hook 'focus-in-hook 'which-key/start-open-timer) - (which-key/stop-open-timer))) + (if which-key-mode + (progn + (unless which-key--setup-p (which-key/setup)) + (add-hook 'focus-out-hook 'which-key/stop-open-timer) + (add-hook 'focus-in-hook 'which-key/start-open-timer) + (which-key/start-open-timer)) + (remove-hook 'focus-out-hook 'which-key/stop-open-timer) + (remove-hook 'focus-in-hook 'which-key/start-open-timer) + (which-key/stop-open-timer))) (defun which-key/setup () "Create buffer for which-key." @@ -93,75 +94,112 @@ currently disabled.") (setq-local cursor-in-non-selected-windows nil)) (setq which-key--setup-p t)) -;; Helper functions +;; Timers -(defsubst which-key/truncate-description (desc) - "Truncate DESC description to `which-key-max-description-length'." - (if (> (length desc) which-key-max-description-length) - (concat (substring desc 0 which-key-max-description-length) "..") - desc)) +(defun which-key/start-open-timer () + "Activate idle timer." + (which-key/stop-open-timer) ; start over + (setq which-key--open-timer + (run-with-idle-timer which-key-idle-delay t 'which-key/update))) -(defun which-key/available-lines () - "Only works for minibuffer right now." - (when (eq which-key-display-method 'minibuffer) - (if (floatp max-mini-window-height) - (floor (* (frame-text-lines) - max-mini-window-height)) - max-mini-window-height))) +(defun which-key/stop-open-timer () + "Deactivate idle timer." + (when which-key--open-timer (cancel-timer which-key--open-timer))) -(defun which-key/replace-strings-from-alist (replacements) - "Find and replace text in buffer according to REPLACEMENTS, -which is an alist where the car of each element is the text to -replace and the cdr is the replacement text." - (dolist (rep replacements) - (save-excursion - (goto-char (point-min)) - (while (or (search-forward (car rep) nil t)) - (replace-match (cdr rep) t t))))) +(defun which-key/start-close-timer () + "Activate idle timer." + (which-key/stop-close-timer) ; start over + (setq which-key--close-timer + (run-at-time which-key-close-buffer-idle-delay + nil 'which-key/hide-buffer))) -;; in case I decide to add padding -;; (defsubst which-key/buffer-height (line-breaks) line-breaks) +(defun which-key/stop-close-timer () + "Deactivate idle timer." + (when which-key--close-timer (cancel-timer which-key--close-timer))) + +;; Update + +(defun which-key/update () + "Fill which-key--buffer with key descriptions and reformat. +Finally, show the buffer." + (let ((key (this-single-command-keys))) + (if (> (length key) 0) + (progn + (which-key/stop-close-timer) + (which-key/hide-buffer) + (let* ((buf (current-buffer)) + ;; (bottom-or-top (member which-key-buffer-position '(top bottom))) + ;; get formatted key bindings + (fmt-width-cons (which-key/get-formatted-key-bindings buf key)) + (formatted-keys (car fmt-width-cons)) + (column-width (cdr fmt-width-cons)) + (buffer-width (which-key/buffer-width column-width (window-width))) + ;; populate target buffer + (n-lines (which-key/populate-buffer formatted-keys column-width buffer-width))) + ;; show buffer + (when (which-key/show-buffer n-lines buffer-width) + (which-key/start-close-timer)))) + ;; command finished maybe close the window + (which-key/hide-buffer)))) + +;; Show/hide guide buffer + +(defun which-key/hide-buffer () + (when (buffer-live-p which-key--buffer) + (delete-windows-on which-key--buffer))) + +(defun which-key/show-buffer (height width) + "Show guide window. +Return nil if no window is shown, or if there is no need to start the +closing timer." + (cl-case which-key-display-method + (minibuffer (which-key/show-buffer-minibuf height width)) + (side-window (which-key/show-buffer-db height width)))) + +(defun which-key/show-buffer-minibuf (height width) + nil) + +(defun which-key/show-buffer-db (height width) + (let* ((side which-key-buffer-position) + (alist (delq nil (list (when side (cons 'side side)) + (when height (cons 'window-height height)) + (when width (cons 'window-width width)))))) + (display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist)))) + +;; Size functions (defun which-key/buffer-width (column-width sel-window-width) - (cond ((eq which-key-display-method 'minibuffer) - (frame-text-cols)) - ((and (eq which-key-buffer-display-function 'display-buffer-in-side-window) - (member which-key-buffer-position '(left right))) - (min which-key-vertical-buffer-width column-width)) - ((eq which-key-buffer-display-function 'display-buffer-in-side-window) - (frame-text-width)) - ;; ((eq which-key-buffer-display-function 'display-buffer-below-selected) - ;; sel-window-width) - (t nil))) + (cl-case which-key-display-method + (minibuffer (which-key/buffer-width-minibuf column-width sel-window-width)) + (side-window (which-key/buffer-width-db column-width sel-window-width)))) -(defun which-key/format-matches (unformatted max-len-key max-len-desc) - "Turn each key-desc-cons in UNFORMATTED into formatted -strings (including text properties), and pad with spaces so that -all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the -longest key and description in the buffer, respectively." - (mapcar - (lambda (key-desc-cons) - (let* ((key (car key-desc-cons)) - (desc (cdr key-desc-cons)) - (group (string-match-p "^group:" desc)) - (desc (if group (substring desc 6) desc)) - (prefix (string-match-p "^Prefix" desc)) - (desc (if (or prefix group) (concat "+" desc) desc)) - (desc-face (if (or prefix group) - 'font-lock-keyword-face 'font-lock-function-name-face)) - ;; (sign (if (or prefix group) "▶" "→")) - (sign "→") - (desc (which-key/truncate-description desc)) - ;; pad keys to max-len-key - (padded-key (s-pad-left max-len-key " " key)) - (padded-desc (s-pad-right max-len-desc " " desc))) - (format (concat (propertize "%s" 'face 'font-lock-constant-face) " " - (propertize sign 'face 'font-lock-comment-face) " " - (propertize "%s" 'face desc-face) " ") - padded-key padded-desc))) - unformatted)) +(defun which-key/buffer-width-minibuf (column-width sel-window-width) + (frame-text-cols)) -;; "Core" functions +(defun which-key/buffer-width-db (column-width sel-window-width) + (if (member which-key-buffer-position '(left right)) + (min which-key-vertical-buffer-width column-width) + (frame-width))) + +(defun which-key/available-lines () + (cl-case which-key-display-method + (minibuffer (which-key/available-lines-minibuf)) + (side-window (which-key/available-lines-db)))) + +(defun which-key/available-lines-minibuf () + "Only works for minibuffer right now." + (if (floatp max-mini-window-height) + (floor (* (frame-text-lines) + max-mini-window-height)) + max-mini-window-height)) + +(defun which-key/available-lines-db () + (if (member which-key-buffer-position '(left right)) + (frame-height) + ;; FIXME: change to something like (min which-*-height (calculate-max-height)) + which-key-horizontal-buffer-height)) + +;; Buffer contents functions (defun which-key/get-formatted-key-bindings (buffer key) (let ((max-len-key 0) (max-len-desc 0) @@ -207,86 +245,49 @@ longest key and description in the buffer, respectively." (setq str-to-insert (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n")) (if (eq which-key-display-method 'minibuffer) (let (message-log-max) (message "%s" str-to-insert)) - (insert str-to-insert))) + (with-current-buffer which-key--buffer + (insert str-to-insert)))) n-lines)) -(defun which-key/update () - "Fill which-key--buffer with key descriptions and reformat. -Finally, show the buffer." - (let ((key (this-single-command-keys))) - (if (> (length key) 0) - (progn - (when which-key--close-timer (cancel-timer which-key--close-timer)) - (which-key/hide-buffer) - (let* ((buf (current-buffer)) - (bottom-or-top (member which-key-buffer-position '(top bottom))) - ;; get formatted key bindings - (fmt-width-cons (which-key/get-formatted-key-bindings buf key)) - (formatted-keys (car fmt-width-cons)) - (column-width (cdr fmt-width-cons)) - (buffer-width (which-key/buffer-width column-width (window-width))) - n-lines) - ;; populate target buffer - (setq n-lines (which-key/populate-buffer - formatted-keys column-width buffer-width)) - ;; show buffer - (unless (eq which-key-display-method 'minibuffer) - (setq which-key--window (which-key/show-buffer n-lines buffer-width) - which-key--close-timer (run-at-time - which-key-close-buffer-idle-delay - nil 'which-key/hide-buffer))))) - ;; command finished maybe close the window - (which-key/hide-buffer)))) - -;; Timers +(defun which-key/replace-strings-from-alist (replacements) + "Find and replace text in buffer according to REPLACEMENTS, +which is an alist where the car of each element is the text to +replace and the cdr is the replacement text." + (dolist (rep replacements) + (save-excursion + (goto-char (point-min)) + (while (or (search-forward (car rep) nil t)) + (replace-match (cdr rep) t t))))) -(defun which-key/start-open-timer () - "Activate idle timer." - (when which-key--open-timer (cancel-timer which-key--open-timer)); start over - (setq which-key--open-timer - (run-with-idle-timer which-key-idle-delay t 'which-key/update))) +(defun which-key/format-matches (unformatted max-len-key max-len-desc) + "Turn each key-desc-cons in UNFORMATTED into formatted +strings (including text properties), and pad with spaces so that +all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the +longest key and description in the buffer, respectively." + (mapcar + (lambda (key-desc-cons) + (let* ((key (car key-desc-cons)) + (desc (cdr key-desc-cons)) + (group (string-match-p "^group:" desc)) + (desc (if group (substring desc 6) desc)) + (prefix (string-match-p "^Prefix" desc)) + (desc (if (or prefix group) (concat "+" desc) desc)) + (desc-face (if (or prefix group) + 'font-lock-keyword-face 'font-lock-function-name-face)) + ;; (sign (if (or prefix group) "▶" "→")) + (sign "→") + (desc (which-key/truncate-description desc)) + ;; pad keys to max-len-key + (padded-key (s-pad-left max-len-key " " key)) + (padded-desc (s-pad-right max-len-desc " " desc))) + (format (concat (propertize "%s" 'face 'font-lock-constant-face) " " + (propertize sign 'face 'font-lock-comment-face) " " + (propertize "%s" 'face desc-face) " ") + padded-key padded-desc))) + unformatted)) -(defun which-key/stop-open-timer () - "Deactivate idle timer." - (cancel-timer which-key--open-timer)) - -;; Display functions - -(defun which-key/show-buffer-display-buffer (height width) - (let ((side which-key-buffer-position) alist) - (setq alist (list (when side (cons 'side side)) - (when height (cons 'window-height height)) - (when width (cons 'window-width width)))) - (display-buffer "*which-key*" (cons which-key-buffer-display-function alist)))) - -(defun which-key/hide-buffer-display-buffer () - (when (window-live-p which-key--window) - (delete-window which-key--window))) - -(defun which-key/show-buffer-popwin (height width) - "Using popwin popup buffer with dimensions HEIGHT and WIDTH." - (popwin:popup-buffer which-key-buffer-name - :height height - :width width - :noselect t - :position which-key-buffer-position)) - -(defun which-key/hide-buffer-popwin () - "Hide popwin buffer." - (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) - (popwin:close-popup-window))) - -(defun which-key/make-display-method-aliases (method) - (cond - ((eq method 'minibuffer) - (defun which-key/hide-buffer ())) - ((member method '(popwin display-buffer)) - (defalias 'which-key/show-buffer - (intern (concat "which-key/show-buffer-" (symbol-name method)))) - (defalias 'which-key/hide-buffer - (intern (concat "which-key/hide-buffer-" (symbol-name method))))) - (t (error "error: Invalid choice for which-key-display-method")))) - -(provide 'which-key) - -;;; which-key.el ends here +(defsubst which-key/truncate-description (desc) + "Truncate DESC description to `which-key-max-description-length'." + (if (> (length desc) which-key-max-description-length) + (concat (substring desc 0 which-key-max-description-length) "..") + desc)) commit ffbdc2a3ca00d137fc60a1b2607c67023456f4e1 Author: Justin Burkett Date: Sat Jul 4 11:10:20 2015 -0400 Reorganize code a little diff --git a/which-key.el b/which-key.el index ec20b6ca49d..898c12e52d0 100644 --- a/which-key.el +++ b/which-key.el @@ -93,6 +93,8 @@ currently disabled.") (setq-local cursor-in-non-selected-windows nil)) (setq which-key--setup-p t)) +;; Helper functions + (defsubst which-key/truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." (if (> (length desc) which-key-max-description-length) @@ -159,6 +161,8 @@ longest key and description in the buffer, respectively." padded-key padded-desc))) unformatted)) +;; "Core" functions + (defun which-key/get-formatted-key-bindings (buffer key) (let ((max-len-key 0) (max-len-desc 0) (key-str-qt (regexp-quote (key-description key))) @@ -234,6 +238,18 @@ Finally, show the buffer." ;; command finished maybe close the window (which-key/hide-buffer)))) +;; Timers + +(defun which-key/start-open-timer () + "Activate idle timer." + (when which-key--open-timer (cancel-timer which-key--open-timer)); start over + (setq which-key--open-timer + (run-with-idle-timer which-key-idle-delay t 'which-key/update))) + +(defun which-key/stop-open-timer () + "Deactivate idle timer." + (cancel-timer which-key--open-timer)) + ;; Display functions (defun which-key/show-buffer-display-buffer (height width) @@ -271,16 +287,6 @@ Finally, show the buffer." (intern (concat "which-key/hide-buffer-" (symbol-name method))))) (t (error "error: Invalid choice for which-key-display-method")))) -(defun which-key/start-open-timer () - "Activate idle timer." - (when which-key--open-timer (cancel-timer which-key--open-timer)); start over - (setq which-key--open-timer - (run-with-idle-timer which-key-idle-delay t 'which-key/update))) - -(defun which-key/stop-open-timer () - "Deactivate idle timer." - (cancel-timer which-key--open-timer)) - (provide 'which-key) ;;; which-key.el ends here commit 17b5f3dfd9144ad32ad96290ca1af11d5f2495f7 Author: Justin Burkett Date: Sat Jul 4 11:06:07 2015 -0400 Factor out display functions To add customization options later diff --git a/which-key.el b/which-key.el index 0efd1aabd1d..ec20b6ca49d 100644 --- a/which-key.el +++ b/which-key.el @@ -42,9 +42,11 @@ cells for replacing any text, keys and descriptions.") "Position of which-key buffer.") (defvar which-key-vertical-buffer-width 60 "Width of which-key buffer .") -(defvar which-key-use-minibuffer t - "Use the minibuffer to display the keybindings. This seems to -be the most foolproof, so it's the default for now") +(defvar which-key-display-method 'minibuffer + "Controls the method used to display the keys. The default is +minibuffer, but other possibilities are 'popwin and +'display-buffer. You will also be able write your own display +function (not implemented yet).") (defconst which-key-buffer-display-function 'display-buffer-in-side-window @@ -73,12 +75,23 @@ currently disabled.") (if which-key-mode (progn (unless which-key--setup-p (which-key/setup)) - (add-hook 'focus-out-hook 'which-key/turn-off-timer) - (add-hook 'focus-in-hook 'which-key/turn-on-timer) - (which-key/turn-on-timer)) - (remove-hook 'focus-out-hook 'which-key/turn-off-timer) - (remove-hook 'focus-in-hook 'which-key/turn-on-timer) - (which-key/turn-off-timer))) + (add-hook 'focus-out-hook 'which-key/stop-open-timer) + (add-hook 'focus-in-hook 'which-key/start-open-timer) + (which-key/make-display-method-aliases which-key-display-method) + (which-key/start-open-timer)) + (remove-hook 'focus-out-hook 'which-key/stop-open-timer) + (remove-hook 'focus-in-hook 'which-key/start-open-timer) + (which-key/stop-open-timer))) + +(defun which-key/setup () + "Create buffer for which-key." + (require 's) + (require 'popwin) + (setq which-key--buffer (get-buffer-create which-key-buffer-name)) + (with-current-buffer which-key--buffer + (setq-local cursor-type nil) + (setq-local cursor-in-non-selected-windows nil)) + (setq which-key--setup-p t)) (defsubst which-key/truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." @@ -88,7 +101,7 @@ currently disabled.") (defun which-key/available-lines () "Only works for minibuffer right now." - (when which-key-use-minibuffer + (when (eq which-key-display-method 'minibuffer) (if (floatp max-mini-window-height) (floor (* (frame-text-lines) max-mini-window-height)) @@ -108,7 +121,8 @@ replace and the cdr is the replacement text." ;; (defsubst which-key/buffer-height (line-breaks) line-breaks) (defun which-key/buffer-width (column-width sel-window-width) - (cond (which-key-use-minibuffer (frame-text-cols)) + (cond ((eq which-key-display-method 'minibuffer) + (frame-text-cols)) ((and (eq which-key-buffer-display-function 'display-buffer-in-side-window) (member which-key-buffer-position '(left right))) (min which-key-vertical-buffer-width column-width)) @@ -187,12 +201,12 @@ longest key and description in the buffer, respectively." (push (subseq formatted-keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) lines))) (setq str-to-insert (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n")) - (if which-key-use-minibuffer + (if (eq which-key-display-method 'minibuffer) (let (message-log-max) (message "%s" str-to-insert)) (insert str-to-insert))) n-lines)) -(defun which-key/update-buffer-and-show () +(defun which-key/update () "Fill which-key--buffer with key descriptions and reformat. Finally, show the buffer." (let ((key (this-single-command-keys))) @@ -210,58 +224,60 @@ Finally, show the buffer." n-lines) ;; populate target buffer (setq n-lines (which-key/populate-buffer - formatted-keys column-width buffer-width))) - ;; maybe show buffer - (unless which-key-use-minibuffer - (setq which-key--window (which-key/show-buffer n-lines buffer-width) - which-key--close-timer (run-at-time - which-key-close-buffer-idle-delay - nil 'which-key/hide-buffer)))) + formatted-keys column-width buffer-width)) + ;; show buffer + (unless (eq which-key-display-method 'minibuffer) + (setq which-key--window (which-key/show-buffer n-lines buffer-width) + which-key--close-timer (run-at-time + which-key-close-buffer-idle-delay + nil 'which-key/hide-buffer))))) ;; command finished maybe close the window (which-key/hide-buffer)))) -(defun which-key/setup () - "Create buffer for which-key." - (require 's) - (require 'popwin) - (setq which-key--buffer (get-buffer-create which-key-buffer-name)) - (with-current-buffer which-key--buffer - (setq-local cursor-type nil) - (setq-local cursor-in-non-selected-windows nil)) - (setq which-key--setup-p t)) +;; Display functions -;; (defun which-key/show-buffer (height width) -;; (let ((side which-key-buffer-position) alist) -;; (setq alist (list (when side (cons 'side side)) -;; (when height (cons 'window-height height)) -;; (when width (cons 'window-width width)))) -;; (display-buffer "*which-key*" (cons which-key-buffer-display-function alist)))) +(defun which-key/show-buffer-display-buffer (height width) + (let ((side which-key-buffer-position) alist) + (setq alist (list (when side (cons 'side side)) + (when height (cons 'window-height height)) + (when width (cons 'window-width width)))) + (display-buffer "*which-key*" (cons which-key-buffer-display-function alist)))) -;; (defun which-key/hide-buffer () -;; "Like it says :\)" -;; (when (window-live-p which-key--window) -;; (delete-window which-key--window))) +(defun which-key/hide-buffer-display-buffer () + (when (window-live-p which-key--window) + (delete-window which-key--window))) -(defun which-key/show-buffer (height width) +(defun which-key/show-buffer-popwin (height width) "Using popwin popup buffer with dimensions HEIGHT and WIDTH." (popwin:popup-buffer which-key-buffer-name - :width width :height height + :width width :noselect t :position which-key-buffer-position)) -(defun which-key/hide-buffer () +(defun which-key/hide-buffer-popwin () "Hide popwin buffer." - (when (and (not which-key-use-minibuffer) - (eq popwin:popup-buffer (get-buffer which-key--buffer))) + (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) (popwin:close-popup-window))) -(defun which-key/turn-on-timer () +(defun which-key/make-display-method-aliases (method) + (cond + ((eq method 'minibuffer) + (defun which-key/hide-buffer ())) + ((member method '(popwin display-buffer)) + (defalias 'which-key/show-buffer + (intern (concat "which-key/show-buffer-" (symbol-name method)))) + (defalias 'which-key/hide-buffer + (intern (concat "which-key/hide-buffer-" (symbol-name method))))) + (t (error "error: Invalid choice for which-key-display-method")))) + +(defun which-key/start-open-timer () "Activate idle timer." + (when which-key--open-timer (cancel-timer which-key--open-timer)); start over (setq which-key--open-timer - (run-with-idle-timer which-key-idle-delay t 'which-key/update-buffer-and-show))) + (run-with-idle-timer which-key-idle-delay t 'which-key/update))) -(defun which-key/turn-off-timer () +(defun which-key/stop-open-timer () "Deactivate idle timer." (cancel-timer which-key--open-timer)) commit add8fca39f57a6ec7535a688bb374d6d37f2bab6 Author: Justin Burkett Date: Fri Jul 3 23:29:07 2015 -0400 Change formatting of groups diff --git a/which-key.el b/which-key.el index c9f61ed12fc..0efd1aabd1d 100644 --- a/which-key.el +++ b/which-key.el @@ -32,7 +32,8 @@ '((">". "") ("<" . "") ("left" ."←") ("right" . "→")) "The strings in the car of each cons cell are replaced with the strings in the cdr for each key.") -(defvar which-key-general-replacement-alist nil +(defvar which-key-general-replacement-alist + '(("Prefix Command" . "prefix")) "See `which-key-key-replacement-alist'. This is a list of cons cells for replacing any text, keys and descriptions.") (defvar which-key-buffer-name "*which-key*" @@ -98,14 +99,10 @@ currently disabled.") which is an alist where the car of each element is the text to replace and the cdr is the replacement text." (dolist (rep replacements) - (let ((trunc-car (which-key/truncate-description (car rep))) - old-face) (save-excursion (goto-char (point-min)) - (while (or (search-forward (car rep) nil t) - (search-forward trunc-car nil t)) - (setq old-face (get-text-property (match-beginning 0) 'face)) - (replace-match (propertize (cdr rep) 'face old-face) nil t)))))) + (while (or (search-forward (car rep) nil t)) + (replace-match (cdr rep) t t))))) ;; in case I decide to add padding ;; (defsubst which-key/buffer-height (line-breaks) line-breaks) @@ -131,14 +128,17 @@ longest key and description in the buffer, respectively." (let* ((key (car key-desc-cons)) (desc (cdr key-desc-cons)) (group (string-match-p "^group:" desc)) + (desc (if group (substring desc 6) desc)) (prefix (string-match-p "^Prefix" desc)) + (desc (if (or prefix group) (concat "+" desc) desc)) (desc-face (if (or prefix group) 'font-lock-keyword-face 'font-lock-function-name-face)) - (sign (if (or prefix group) "▶" "→")) - (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc))) + ;; (sign (if (or prefix group) "▶" "→")) + (sign "→") + (desc (which-key/truncate-description desc)) ;; pad keys to max-len-key (padded-key (s-pad-left max-len-key " " key)) - (padded-desc (s-pad-right max-len-desc " " tmp-desc))) + (padded-desc (s-pad-right max-len-desc " " desc))) (format (concat (propertize "%s" 'face 'font-lock-constant-face) " " (propertize sign 'face 'font-lock-comment-face) " " (propertize "%s" 'face desc-face) " ") commit 8d9f79ac14d74895d905880e1fc28266c06ff123 Author: Justin Burkett Date: Fri Jul 3 23:01:17 2015 -0400 Toggle timer on frame focus diff --git a/which-key.el b/which-key.el index 968999791ea..c9f61ed12fc 100644 --- a/which-key.el +++ b/which-key.el @@ -57,8 +57,8 @@ currently disabled.") "Internal: Holds reference to which-key buffer.") (defvar which-key--window nil "Internal: Holds reference to which-key window.") -(defvar which-key--timer nil - "Internal: Holds reference to timer.") +(defvar which-key--open-timer nil + "Internal: Holds reference to open window timer.") (defvar which-key--close-timer nil "Internal: Holds reference to close window timer.") (defvar which-key--setup-p nil @@ -69,11 +69,15 @@ currently disabled.") "Toggle which-key-mode." :global t :lighter " WK" - (funcall (if which-key-mode - (progn - (unless which-key--setup-p (which-key/setup)) - 'which-key/turn-on-timer) - 'which-key/turn-off-timer))) + (if which-key-mode + (progn + (unless which-key--setup-p (which-key/setup)) + (add-hook 'focus-out-hook 'which-key/turn-off-timer) + (add-hook 'focus-in-hook 'which-key/turn-on-timer) + (which-key/turn-on-timer)) + (remove-hook 'focus-out-hook 'which-key/turn-off-timer) + (remove-hook 'focus-in-hook 'which-key/turn-on-timer) + (which-key/turn-off-timer))) (defsubst which-key/truncate-description (desc) "Truncate DESC description to `which-key-max-description-length'." @@ -254,12 +258,12 @@ Finally, show the buffer." (defun which-key/turn-on-timer () "Activate idle timer." - (setq which-key--timer + (setq which-key--open-timer (run-with-idle-timer which-key-idle-delay t 'which-key/update-buffer-and-show))) (defun which-key/turn-off-timer () "Deactivate idle timer." - (cancel-timer which-key--timer)) + (cancel-timer which-key--open-timer)) (provide 'which-key) commit fa368fc61105ebb733af1e3619e9f01e22ee1689 Author: Justin Burkett Date: Fri Jul 3 22:19:50 2015 -0400 Fix index error for subseq diff --git a/which-key.el b/which-key.el index ddd5d009128..968999791ea 100644 --- a/which-key.el +++ b/which-key.el @@ -177,11 +177,11 @@ longest key and description in the buffer, respectively." (max-lines (ceiling (/ (float n-keys) n-columns))) (n-lines (if n-lines (min n-lines max-lines) max-lines)) lines str-to-insert start end) - (message "n-lines: %s" n-lines) (when (> n-columns 0) (dotimes (i n-lines) - (setq lines (push (subseq formatted-keys (* i n-columns) (* (1+ i) n-columns)) lines))) - (setq lns lines nlns n-lines) + (setq lines + (push (subseq formatted-keys (* i n-columns) (min n-keys (* (1+ i) n-columns))) + lines))) (setq str-to-insert (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n")) (if which-key-use-minibuffer (let (message-log-max) (message "%s" str-to-insert)) commit 558090e1198398f512cee09f926786a1e194e0b6 Author: Justin Burkett Date: Fri Jul 3 22:10:34 2015 -0400 Switch default to minibuffer There are a lot of changes here. 1. Reorganized and factored a bunch of code. 2. Rewrote the logic to calculate line breaks (much cleaner). 3. Switched to using the minibuffer by default, which seems more foolproof and saves line space (I'm sure there's something wrong with this). diff --git a/which-key.el b/which-key.el index 00106c38416..ddd5d009128 100644 --- a/which-key.el +++ b/which-key.el @@ -34,14 +34,16 @@ strings in the cdr for each key.") (defvar which-key-general-replacement-alist nil "See `which-key-key-replacement-alist'. This is a list of cons -cells for replacing any text, keys and descriptions. You can -also use elisp regexp in the car of the cells.") +cells for replacing any text, keys and descriptions.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-buffer-position 'bottom "Position of which-key buffer.") (defvar which-key-vertical-buffer-width 60 "Width of which-key buffer .") +(defvar which-key-use-minibuffer t + "Use the minibuffer to display the keybindings. This seems to +be the most foolproof, so it's the default for now") (defconst which-key-buffer-display-function 'display-buffer-in-side-window @@ -79,28 +81,13 @@ currently disabled.") (concat (substring desc 0 which-key-max-description-length) "..") desc)) -(defun which-key/format-matches (unformatted max-len-key max-len-desc) - "Turn each key-desc-cons in UNFORMATTED into formatted -strings (including text properties), and pad with spaces so that -all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the -longest key and description in the buffer, respectively." - (mapcar - (lambda (key-desc-cons) - (let* ((key (car key-desc-cons)) - (desc (cdr key-desc-cons)) - (group (string-match-p "^group:" desc)) - (prefix (string-match-p "^Prefix" desc)) - (desc-face (if (or prefix group) - 'font-lock-keyword-face 'font-lock-function-name-face)) - (sign (if (or prefix group) "▶" "→")) - (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc))) - (key-padding (s-repeat (- max-len-key (length key)) " ")) - (padded-desc (s-pad-right max-len-desc " " tmp-desc))) - (format (concat (propertize "%s%s" 'face 'font-lock-constant-face) " " - (propertize sign 'face 'font-lock-comment-face) - (propertize " %s" 'face desc-face)) - key-padding key padded-desc))) - unformatted)) +(defun which-key/available-lines () + "Only works for minibuffer right now." + (when which-key-use-minibuffer + (if (floatp max-mini-window-height) + (floor (* (frame-text-lines) + max-mini-window-height)) + max-mini-window-height))) (defun which-key/replace-strings-from-alist (replacements) "Find and replace text in buffer according to REPLACEMENTS, @@ -110,39 +97,96 @@ replace and the cdr is the replacement text." (let ((trunc-car (which-key/truncate-description (car rep))) old-face) (save-excursion + (goto-char (point-min)) (while (or (search-forward (car rep) nil t) (search-forward trunc-car nil t)) (setq old-face (get-text-property (match-beginning 0) 'face)) (replace-match (propertize (cdr rep) 'face old-face) nil t)))))) -(defun which-key/buffer-width (max-len-key max-len-desc sel-window-width) - (cond ((and (eq which-key-buffer-display-function 'display-buffer-in-side-window) +;; in case I decide to add padding +;; (defsubst which-key/buffer-height (line-breaks) line-breaks) + +(defun which-key/buffer-width (column-width sel-window-width) + (cond (which-key-use-minibuffer (frame-text-cols)) + ((and (eq which-key-buffer-display-function 'display-buffer-in-side-window) (member which-key-buffer-position '(left right))) - (min which-key-vertical-buffer-width (+ 3 max-len-desc max-len-key))) + (min which-key-vertical-buffer-width column-width)) ((eq which-key-buffer-display-function 'display-buffer-in-side-window) - (frame-width)) + (frame-text-width)) ;; ((eq which-key-buffer-display-function 'display-buffer-below-selected) ;; sel-window-width) (t nil))) -(defsubst which-key/buffer-height (line-breaks) (+ 2 line-breaks)) +(defun which-key/format-matches (unformatted max-len-key max-len-desc) + "Turn each key-desc-cons in UNFORMATTED into formatted +strings (including text properties), and pad with spaces so that +all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the +longest key and description in the buffer, respectively." + (mapcar + (lambda (key-desc-cons) + (let* ((key (car key-desc-cons)) + (desc (cdr key-desc-cons)) + (group (string-match-p "^group:" desc)) + (prefix (string-match-p "^Prefix" desc)) + (desc-face (if (or prefix group) + 'font-lock-keyword-face 'font-lock-function-name-face)) + (sign (if (or prefix group) "▶" "→")) + (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc))) + ;; pad keys to max-len-key + (padded-key (s-pad-left max-len-key " " key)) + (padded-desc (s-pad-right max-len-desc " " tmp-desc))) + (format (concat (propertize "%s" 'face 'font-lock-constant-face) " " + (propertize sign 'face 'font-lock-comment-face) " " + (propertize "%s" 'face desc-face) " ") + padded-key padded-desc))) + unformatted)) + +(defun which-key/get-formatted-key-bindings (buffer key) + (let ((max-len-key 0) (max-len-desc 0) + (key-str-qt (regexp-quote (key-description key))) + key-match desc-match unformatted formatted) + (with-temp-buffer + (describe-buffer-bindings buffer key) + (which-key/replace-strings-from-alist which-key-general-replacement-alist) + (goto-char (point-max)) ; want to put last keys in first + (while (re-search-backward + (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" + key-str-qt) + nil t) + (setq key-match (s-replace-all + which-key-key-replacement-alist (match-string 1)) + desc-match (match-string 2) + max-len-key (max max-len-key (length key-match)) + max-len-desc (max max-len-desc (length desc-match))) + (cl-pushnew (cons key-match desc-match) unformatted + :test (lambda (x y) (string-equal (car x) (car y))))) + (setq max-len-desc (if (> max-len-desc which-key-max-description-length) + (+ 2 which-key-max-description-length) ; for the .. + max-len-desc) + formatted (which-key/format-matches + unformatted max-len-key max-len-desc))) + (cons formatted (+ 4 max-len-key max-len-desc)))) -(defun which-key/insert-keys (formatted-strings buffer-width) +(defun which-key/populate-buffer (formatted-keys column-width buffer-width) "Insert FORMATTED-STRINGS into buffer, breaking after BUFFER-WIDTH." - (let ((char-count 0) - (line-breaks 0) - (width (if buffer-width buffer-width (frame-width)))) - (insert (mapconcat - (lambda (str) - (let* ((str-len (length (substring-no-properties str))) - (new-count (+ char-count str-len))) - (if (> new-count width) - (progn (setq char-count str-len) - (cl-incf line-breaks) - (concat "\n" str)) - (setq char-count new-count) - str))) formatted-strings "")) - line-breaks)) + (let* ((char-count 0) (line-breaks 0) (this-column 1) + (width (if buffer-width buffer-width (frame-text-width))) + (n-keys (length formatted-keys)) + (n-columns (/ width column-width)) ;; integer division + (n-lines (which-key/available-lines)) + (max-lines (ceiling (/ (float n-keys) n-columns))) + (n-lines (if n-lines (min n-lines max-lines) max-lines)) + lines str-to-insert start end) + (message "n-lines: %s" n-lines) + (when (> n-columns 0) + (dotimes (i n-lines) + (setq lines (push (subseq formatted-keys (* i n-columns) (* (1+ i) n-columns)) lines))) + (setq lns lines nlns n-lines) + (setq str-to-insert (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n")) + (if which-key-use-minibuffer + (let (message-log-max) (message "%s" str-to-insert)) + (insert str-to-insert))) + n-lines)) (defun which-key/update-buffer-and-show () "Fill which-key--buffer with key descriptions and reformat. @@ -152,51 +196,24 @@ Finally, show the buffer." (progn (when which-key--close-timer (cancel-timer which-key--close-timer)) (which-key/hide-buffer) - (let ((buf (current-buffer)) (win-width (window-width)) - (key-str-qt (regexp-quote (key-description key))) - (bottom-or-top (member which-key-buffer-position '(top bottom))) - (max-len-key 0) (max-len-desc 0) - key-match desc-match unformatted formatted buffer-width - line-breaks) - ;; get keybindings - (with-temp-buffer - (describe-buffer-bindings buf key) - (goto-char (point-max)) - (while (re-search-backward - (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" - key-str-qt) - nil t) - (setq key-match (s-replace-all - which-key-key-replacement-alist (match-string 1)) - desc-match (match-string 2) - max-len-key (max max-len-key (length key-match)) - max-len-desc (max max-len-desc (length desc-match))) - (cl-pushnew (cons key-match desc-match) unformatted - :test (lambda (x y) (string-equal (car x) (car y))))) - (setq max-len-desc (if (> max-len-desc which-key-max-description-length) - (+ 2 which-key-max-description-length) ; for the .. - max-len-desc) - max-len-desc (1+ max-len-desc) ; pad with one character - formatted (which-key/format-matches - unformatted max-len-key max-len-desc))) - ;; populate buffer - (with-current-buffer (get-buffer which-key--buffer) - (erase-buffer) - (setq buffer-width (which-key/buffer-width - max-len-key max-len-desc win-width) - line-breaks (which-key/insert-keys - formatted buffer-width)) - (goto-char (point-min)) - (which-key/replace-strings-from-alist - which-key-general-replacement-alist)) - ;; show buffer - (setq which-key--window (which-key/show-buffer - (which-key/buffer-height line-breaks) - buffer-width)) - (setq which-key--close-timer (run-at-time + (let* ((buf (current-buffer)) + (bottom-or-top (member which-key-buffer-position '(top bottom))) + ;; get formatted key bindings + (fmt-width-cons (which-key/get-formatted-key-bindings buf key)) + (formatted-keys (car fmt-width-cons)) + (column-width (cdr fmt-width-cons)) + (buffer-width (which-key/buffer-width column-width (window-width))) + n-lines) + ;; populate target buffer + (setq n-lines (which-key/populate-buffer + formatted-keys column-width buffer-width))) + ;; maybe show buffer + (unless which-key-use-minibuffer + (setq which-key--window (which-key/show-buffer n-lines buffer-width) + which-key--close-timer (run-at-time which-key-close-buffer-idle-delay nil 'which-key/hide-buffer)))) - ;; close the window + ;; command finished maybe close the window (which-key/hide-buffer)))) (defun which-key/setup () @@ -222,7 +239,7 @@ Finally, show the buffer." ;; (delete-window which-key--window))) (defun which-key/show-buffer (height width) - "Usign popwin popup buffer with dimensions HEIGHT and WIDTH." + "Using popwin popup buffer with dimensions HEIGHT and WIDTH." (popwin:popup-buffer which-key-buffer-name :width width :height height @@ -231,7 +248,8 @@ Finally, show the buffer." (defun which-key/hide-buffer () "Hide popwin buffer." - (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) + (when (and (not which-key-use-minibuffer) + (eq popwin:popup-buffer (get-buffer which-key--buffer))) (popwin:close-popup-window))) (defun which-key/turn-on-timer () commit 3e704213fb01925a5c1c25b22ea740e57b8c419c Author: Justin Burkett Date: Fri Jul 3 15:36:55 2015 -0400 Update docstrings and fix packaging diff --git a/which-key.el b/which-key.el index c5ff68ab2dd..00106c38416 100644 --- a/which-key.el +++ b/which-key.el @@ -1,4 +1,4 @@ -;;; which-key.el +;;; which-key.el --- Display available keybindings in popup ;; Copyright (C) 2015 Justin Burkett @@ -6,7 +6,7 @@ ;; URL: https://github.com/justbur/which-key/ ;; Version: 0.1 ;; Keywords: -;; Package-Requires: ((s "1.9.0" popwin "1.0.0")) +;; Package-Requires: ((s "1.9.0") (popwin "1.0.0")) ;;; Commentary: ;; @@ -21,37 +21,36 @@ ;;; Code: - (defvar which-key-idle-delay 0.6 "Delay (in seconds) for which-key buffer to popup.") (defvar which-key-close-buffer-idle-delay 4 "Delay (in seconds) after which buffer is forced closed.") (defvar which-key-max-description-length 27 - "Truncate the description of keys to this length (adds - \"..\")") + "Truncate the description of keys to this length. Also adds +\"..\".") (defvar which-key-key-replacement-alist '((">". "") ("<" . "") ("left" ."←") ("right" . "→")) "The strings in the car of each cons cell are replaced with the - strings in the cdr for each key.") +strings in the cdr for each key.") (defvar which-key-general-replacement-alist nil - "See `which-key-key-replacement-alist'. This is a list of cons - cells for replacing any text, keys and descriptions. You can - also use elisp regexp in the car of the cells.") + "See `which-key-key-replacement-alist'. This is a list of cons +cells for replacing any text, keys and descriptions. You can +also use elisp regexp in the car of the cells.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-buffer-position 'bottom - "Position of which-key buffer") + "Position of which-key buffer.") (defvar which-key-vertical-buffer-width 60 "Width of which-key buffer .") (defconst which-key-buffer-display-function 'display-buffer-in-side-window - "Controls where the buffer is displayed. - The current default is also controlled by - `which-key-buffer-position'. Other options are currently - disabled.") + "Controls where the buffer is displayed. The current default is +also controlled by `which-key-buffer-position'. Other options are +currently disabled.") ;; Internal Vars +(defvar popwin:popup-buffer nil) (defvar which-key--buffer nil "Internal: Holds reference to which-key buffer.") (defvar which-key--window nil @@ -61,8 +60,9 @@ (defvar which-key--close-timer nil "Internal: Holds reference to close window timer.") (defvar which-key--setup-p nil - "Internal: Non-nil if which-key buffer has been setup") + "Internal: Non-nil if which-key buffer has been setup.") +;;;###autoload (define-minor-mode which-key-mode "Toggle which-key-mode." :global t @@ -74,15 +74,16 @@ 'which-key/turn-off-timer))) (defsubst which-key/truncate-description (desc) - "Truncate key description to `which-key-max-description-length'." + "Truncate DESC description to `which-key-max-description-length'." (if (> (length desc) which-key-max-description-length) (concat (substring desc 0 which-key-max-description-length) "..") desc)) (defun which-key/format-matches (unformatted max-len-key max-len-desc) - "Turn `key-desc-cons' into formatted strings (including text -properties), and pad with spaces so that all are a uniform -length." + "Turn each key-desc-cons in UNFORMATTED into formatted +strings (including text properties), and pad with spaces so that +all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the +longest key and description in the buffer, respectively." (mapcar (lambda (key-desc-cons) (let* ((key (car key-desc-cons)) @@ -104,7 +105,7 @@ length." (defun which-key/replace-strings-from-alist (replacements) "Find and replace text in buffer according to REPLACEMENTS, which is an alist where the car of each element is the text to -replace and the cdr is the replacement text. " +replace and the cdr is the replacement text." (dolist (rep replacements) (let ((trunc-car (which-key/truncate-description (car rep))) old-face) @@ -127,7 +128,7 @@ replace and the cdr is the replacement text. " (defsubst which-key/buffer-height (line-breaks) (+ 2 line-breaks)) (defun which-key/insert-keys (formatted-strings buffer-width) - "Insert strings into buffer breaking after `which-key-buffer-width'." + "Insert FORMATTED-STRINGS into buffer, breaking after BUFFER-WIDTH." (let ((char-count 0) (line-breaks 0) (width (if buffer-width buffer-width (frame-width)))) @@ -221,6 +222,7 @@ Finally, show the buffer." ;; (delete-window which-key--window))) (defun which-key/show-buffer (height width) + "Usign popwin popup buffer with dimensions HEIGHT and WIDTH." (popwin:popup-buffer which-key-buffer-name :width width :height height @@ -228,7 +230,7 @@ Finally, show the buffer." :position which-key-buffer-position)) (defun which-key/hide-buffer () - "Like it says :\)" + "Hide popwin buffer." (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) (popwin:close-popup-window))) commit 6875c207b8d8f2e73a75feb7a750780bd99bda59 Author: Justin Burkett Date: Fri Jul 3 13:25:26 2015 -0400 Move cursor code to setup diff --git a/which-key.el b/which-key.el index cc0c772d692..c5ff68ab2dd 100644 --- a/which-key.el +++ b/which-key.el @@ -178,6 +178,7 @@ Finally, show the buffer." max-len-desc (1+ max-len-desc) ; pad with one character formatted (which-key/format-matches unformatted max-len-key max-len-desc))) + ;; populate buffer (with-current-buffer (get-buffer which-key--buffer) (erase-buffer) (setq buffer-width (which-key/buffer-width @@ -186,9 +187,8 @@ Finally, show the buffer." formatted buffer-width)) (goto-char (point-min)) (which-key/replace-strings-from-alist - which-key-general-replacement-alist) - (setq-local cursor-type nil) - (setq-local cursor-in-non-selected-windows nil)) + which-key-general-replacement-alist)) + ;; show buffer (setq which-key--window (which-key/show-buffer (which-key/buffer-height line-breaks) buffer-width)) @@ -203,6 +203,9 @@ Finally, show the buffer." (require 's) (require 'popwin) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) + (with-current-buffer which-key--buffer + (setq-local cursor-type nil) + (setq-local cursor-in-non-selected-windows nil)) (setq which-key--setup-p t)) ;; (defun which-key/show-buffer (height width) commit 5af44458b77cfcb089084a6658281d27698bde6e Author: Justin Burkett Date: Fri Jul 3 13:07:07 2015 -0400 Try to hide cursor diff --git a/which-key.el b/which-key.el index 451b7f0886f..cc0c772d692 100644 --- a/which-key.el +++ b/which-key.el @@ -26,7 +26,7 @@ "Delay (in seconds) for which-key buffer to popup.") (defvar which-key-close-buffer-idle-delay 4 "Delay (in seconds) after which buffer is forced closed.") -(defvar which-key-max-description-length 30 +(defvar which-key-max-description-length 27 "Truncate the description of keys to this length (adds \"..\")") (defvar which-key-key-replacement-alist @@ -187,7 +187,8 @@ Finally, show the buffer." (goto-char (point-min)) (which-key/replace-strings-from-alist which-key-general-replacement-alist) - (goto-char (point-max))) + (setq-local cursor-type nil) + (setq-local cursor-in-non-selected-windows nil)) (setq which-key--window (which-key/show-buffer (which-key/buffer-height line-breaks) buffer-width)) commit 31dff26dadc492e4d9e1c66dff98674544a361fb Author: Justin Burkett Date: Fri Jul 3 13:06:43 2015 -0400 Better picture diff --git a/README.org b/README.org index 0b8320cc852..93cbaad6010 100644 --- a/README.org +++ b/README.org @@ -2,7 +2,7 @@ Rewrite of guide-key-mode for emacs. Here's a recent picture showing what it does: -[[./img/which-key-right.png]] +[[./img/which-key-bottom.png]] * Status It is somewhat stable for me at the moment, but expect to see potentially weird diff --git a/img/which-key-bottom.png b/img/which-key-bottom.png new file mode 100644 index 00000000000..f0969813001 Binary files /dev/null and b/img/which-key-bottom.png differ commit 79ec100fb4d502a3e84700b28cf5e8013617449a Author: Justin Burkett Date: Fri Jul 3 12:51:05 2015 -0400 Get the cursor out of the way diff --git a/which-key.el b/which-key.el index 54831b52829..451b7f0886f 100644 --- a/which-key.el +++ b/which-key.el @@ -186,7 +186,8 @@ Finally, show the buffer." formatted buffer-width)) (goto-char (point-min)) (which-key/replace-strings-from-alist - which-key-general-replacement-alist)) + which-key-general-replacement-alist) + (goto-char (point-max))) (setq which-key--window (which-key/show-buffer (which-key/buffer-height line-breaks) buffer-width)) commit beaba56f365fded06d2a63b77f99c5c475773e34 Author: Justin Burkett Date: Fri Jul 3 12:50:37 2015 -0400 Add picture to readme diff --git a/README.org b/README.org index 3fa356d27d3..0b8320cc852 100644 --- a/README.org +++ b/README.org @@ -1,5 +1,9 @@ Rewrite of guide-key-mode for emacs. +Here's a recent picture showing what it does: + +[[./img/which-key-right.png]] + * Status It is somewhat stable for me at the moment, but expect to see potentially weird behavior (then to report it to me!). diff --git a/img/which-key-right.png b/img/which-key-right.png new file mode 100644 index 00000000000..a207d5a82e5 Binary files /dev/null and b/img/which-key-right.png differ commit 5185467c6b193f58b01b84c1f8cf6b7b38c3ed9c Author: Justin Burkett Date: Fri Jul 3 12:00:07 2015 -0400 Arrows are more fun Also add padding between entries diff --git a/which-key.el b/which-key.el index 4bb33922526..54831b52829 100644 --- a/which-key.el +++ b/which-key.el @@ -91,13 +91,14 @@ length." (prefix (string-match-p "^Prefix" desc)) (desc-face (if (or prefix group) 'font-lock-keyword-face 'font-lock-function-name-face)) + (sign (if (or prefix group) "▶" "→")) (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc))) (key-padding (s-repeat (- max-len-key (length key)) " ")) (padded-desc (s-pad-right max-len-desc " " tmp-desc))) - (format (concat (propertize "[" 'face 'font-lock-comment-face) "%s" - (propertize "]" 'face 'font-lock-comment-face) "%s" + (format (concat (propertize "%s%s" 'face 'font-lock-constant-face) " " + (propertize sign 'face 'font-lock-comment-face) (propertize " %s" 'face desc-face)) - key key-padding padded-desc))) + key-padding key padded-desc))) unformatted)) (defun which-key/replace-strings-from-alist (replacements) @@ -174,6 +175,7 @@ Finally, show the buffer." (setq max-len-desc (if (> max-len-desc which-key-max-description-length) (+ 2 which-key-max-description-length) ; for the .. max-len-desc) + max-len-desc (1+ max-len-desc) ; pad with one character formatted (which-key/format-matches unformatted max-len-key max-len-desc))) (with-current-buffer (get-buffer which-key--buffer) commit 5039c93d8626f20f0fda17058cb64cd6e35ebe87 Author: Justin Burkett Date: Fri Jul 3 08:39:26 2015 -0400 Switch readme to org-mode diff --git a/README.md b/README.md deleted file mode 100644 index 6f77947c0d8..00000000000 --- a/README.md +++ /dev/null @@ -1,10 +0,0 @@ -# emacs-which-key -Rewrite of guide-key-mode for emacs. - -It's very rough right now. - -Planned features: - 1. Simplify code, especially the trigger mechanism to make it less resource - intensive than guide-key. - 2. Add option to replace descriptions of keys on the fly. - 3. Switch from using popwin to window-purpose. diff --git a/README.org b/README.org new file mode 100644 index 00000000000..3fa356d27d3 --- /dev/null +++ b/README.org @@ -0,0 +1,12 @@ +Rewrite of guide-key-mode for emacs. + +* Status +It is somewhat stable for me at the moment, but expect to see potentially weird +behavior (then to report it to me!). +** Completed +1. Use idle timers to trigger window popup instead of guide-key's constant + polling. +2. Add support for replacement lists to modify key descriptions on the fly. +** Ongoing/Planned +1. Explore alternatives to popwin like window-pupose and using display-buffer + directly commit c77a6efccb008f2b810e4b74f9b1f0f8cc86f6db Author: Justin Burkett Date: Fri Jul 3 08:32:40 2015 -0400 Switch back to popwin for now diff --git a/which-key.el b/which-key.el index f87c040db5a..4bb33922526 100644 --- a/which-key.el +++ b/which-key.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/justbur/which-key/ ;; Version: 0.1 ;; Keywords: -;; Package-Requires: ((s "1.9.0")) +;; Package-Requires: ((s "1.9.0" popwin "1.0.0")) ;;; Commentary: ;; @@ -21,6 +21,7 @@ ;;; Code: + (defvar which-key-idle-delay 0.6 "Delay (in seconds) for which-key buffer to popup.") (defvar which-key-close-buffer-idle-delay 4 @@ -40,16 +41,16 @@ "Name of which-key buffer.") (defvar which-key-buffer-position 'bottom "Position of which-key buffer") -(defvar which-key-buffer-display-function - 'display-buffer-in-side-window - "Controls where the buffer is displayed. Current options are - the default which is also controlled by - `which-key-buffer-position', and - `display-buffer-below-selected' which displays which-key only - under the currently selected window.") (defvar which-key-vertical-buffer-width 60 "Width of which-key buffer .") +(defconst which-key-buffer-display-function + 'display-buffer-in-side-window + "Controls where the buffer is displayed. + The current default is also controlled by + `which-key-buffer-position'. Other options are currently + disabled.") + ;; Internal Vars (defvar which-key--buffer nil "Internal: Holds reference to which-key buffer.") @@ -62,12 +63,10 @@ (defvar which-key--setup-p nil "Internal: Non-nil if which-key buffer has been setup") - (define-minor-mode which-key-mode "Toggle which-key-mode." :global t :lighter " WK" - :require 's (funcall (if which-key-mode (progn (unless which-key--setup-p (which-key/setup)) @@ -120,8 +119,8 @@ replace and the cdr is the replacement text. " (min which-key-vertical-buffer-width (+ 3 max-len-desc max-len-key))) ((eq which-key-buffer-display-function 'display-buffer-in-side-window) (frame-width)) - ((eq which-key-buffer-display-function 'display-buffer-below-selected) - sel-window-width) + ;; ((eq which-key-buffer-display-function 'display-buffer-below-selected) + ;; sel-window-width) (t nil))) (defsubst which-key/buffer-height (line-breaks) (+ 2 line-breaks)) @@ -193,36 +192,38 @@ Finally, show the buffer." which-key-close-buffer-idle-delay nil 'which-key/hide-buffer)))) ;; close the window - (which-key/hide-buffer))) + (which-key/hide-buffer)))) (defun which-key/setup () "Create buffer for which-key." + (require 's) + (require 'popwin) (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (setq which-key--setup-p t)) -(defun which-key/show-buffer (height width) - (let ((side which-key-buffer-position) alist) - (setq alist (list (when side (cons 'side side)) - (when height (cons 'window-height height)) - (when width (cons 'window-width width)))) - (display-buffer "*which-key*" (cons which-key-buffer-display-function alist)))) - -(defun which-key/hide-buffer () - "Like it says :\)" - (when (window-live-p which-key--window) - (delete-window which-key--window))) - ;; (defun which-key/show-buffer (height width) -;; (popwin:popup-buffer which-key-buffer-name -;; :width width -;; :height height -;; :noselect t -;; :position which-key-buffer-position)) +;; (let ((side which-key-buffer-position) alist) +;; (setq alist (list (when side (cons 'side side)) +;; (when height (cons 'window-height height)) +;; (when width (cons 'window-width width)))) +;; (display-buffer "*which-key*" (cons which-key-buffer-display-function alist)))) ;; (defun which-key/hide-buffer () ;; "Like it says :\)" -;; (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) -;; (popwin:close-popup-window))) +;; (when (window-live-p which-key--window) +;; (delete-window which-key--window))) + +(defun which-key/show-buffer (height width) + (popwin:popup-buffer which-key-buffer-name + :width width + :height height + :noselect t + :position which-key-buffer-position)) + +(defun which-key/hide-buffer () + "Like it says :\)" + (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) + (popwin:close-popup-window))) (defun which-key/turn-on-timer () "Activate idle timer." commit 63fde0d3f28be500c0111a1cc2c3515b8377e92f Author: Justin Burkett Date: Fri Jul 3 08:12:10 2015 -0400 Remove unnecessary checks diff --git a/which-key.el b/which-key.el index 4f2220436d1..f87c040db5a 100644 --- a/which-key.el +++ b/which-key.el @@ -193,7 +193,7 @@ Finally, show the buffer." which-key-close-buffer-idle-delay nil 'which-key/hide-buffer)))) ;; close the window - (when (window-live-p which-key--window) (which-key/hide-buffer))))) + (which-key/hide-buffer))) (defun which-key/setup () "Create buffer for which-key." commit 230ffc306f59897638eb7bd634f0c4329d03f84e Author: Justin Burkett Date: Fri Jul 3 08:09:27 2015 -0400 Save popwin functions as comments diff --git a/which-key.el b/which-key.el index 95a5f76f9b6..4f2220436d1 100644 --- a/which-key.el +++ b/which-key.el @@ -212,6 +212,18 @@ Finally, show the buffer." (when (window-live-p which-key--window) (delete-window which-key--window))) +;; (defun which-key/show-buffer (height width) +;; (popwin:popup-buffer which-key-buffer-name +;; :width width +;; :height height +;; :noselect t +;; :position which-key-buffer-position)) + +;; (defun which-key/hide-buffer () +;; "Like it says :\)" +;; (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) +;; (popwin:close-popup-window))) + (defun which-key/turn-on-timer () "Activate idle timer." (setq which-key--timer commit 776e39e98b0628be2119cf929662909eb30cacc6 Merge: d57fca695d6 5614be0e7d3 Author: Justin Burkett Date: Fri Jul 3 08:07:02 2015 -0400 Merge branch 'display-buffer' commit 5614be0e7d3df3bbc9870b9c81be125ebf22ad18 Author: Justin Burkett Date: Thu Jul 2 21:33:35 2015 -0400 Remove commented funcs and messages diff --git a/which-key.el b/which-key.el index d7745ddb8fb..95a5f76f9b6 100644 --- a/which-key.el +++ b/which-key.el @@ -67,7 +67,6 @@ "Toggle which-key-mode." :global t :lighter " WK" - ;; :require 'popwin :require 's (funcall (if which-key-mode (progn @@ -127,28 +126,6 @@ replace and the cdr is the replacement text. " (defsubst which-key/buffer-height (line-breaks) (+ 2 line-breaks)) -;; (defun which-key/window-params-alist (max-len-key max-len-desc line-breaks selected-buf) -;; (let ((disp-func which-key-buffer-display-function) -;; (position which-key-buffer-position) -;; (selected-window (buffer-w)) -;; width height side) -;; (cond -;; ((and (eq disp-func 'display-buffer-in-side-window) -;; (member position '(left right))) -;; (setq width (which-key/vertical-buffer-width max-len-desc max-len-key) -;; height (frame-height) -;; side position)) -;; ((eq disp-func 'display-buffer-in-side-window) -;; (setq width (frame-width) -;; height (+ 2 line-breaks) -;; side position)) -;; ((eq disp-func 'display-buffer-below-selected) -;; (setq height (+ 2 line-breaks))) -;; (t (error "error: Using unsupported buffer display function"))) -;; (list (when width (cons 'window-width width)) -;; (cons 'window-height height) -;; (when side (cons 'side side))))) - (defun which-key/insert-keys (formatted-strings buffer-width) "Insert strings into buffer breaking after `which-key-buffer-width'." (let ((char-count 0) @@ -223,19 +200,11 @@ Finally, show the buffer." (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (setq which-key--setup-p t)) -;; (defun which-key/show-buffer-popwin (height width) -;; (popwin:popup-buffer which-key-buffer-name -;; :width width -;; :height height -;; :noselect t -;; :position which-key-buffer-position)) - (defun which-key/show-buffer (height width) (let ((side which-key-buffer-position) alist) (setq alist (list (when side (cons 'side side)) (when height (cons 'window-height height)) (when width (cons 'window-width width)))) - (message "h: %s w: %s s: %s" height width side) (display-buffer "*which-key*" (cons which-key-buffer-display-function alist)))) (defun which-key/hide-buffer () commit 41d0d60c3d131ef58e52213b0e86ae91c5baa7f8 Author: Justin Burkett Date: Thu Jul 2 21:28:48 2015 -0400 Add option to select display-buffer function. Only 2 are implemented at the moment. diff --git a/which-key.el b/which-key.el index 28026641d1c..d7745ddb8fb 100644 --- a/which-key.el +++ b/which-key.el @@ -40,6 +40,13 @@ "Name of which-key buffer.") (defvar which-key-buffer-position 'bottom "Position of which-key buffer") +(defvar which-key-buffer-display-function + 'display-buffer-in-side-window + "Controls where the buffer is displayed. Current options are + the default which is also controlled by + `which-key-buffer-position', and + `display-buffer-below-selected' which displays which-key only + under the currently selected window.") (defvar which-key-vertical-buffer-width 60 "Width of which-key buffer .") @@ -55,6 +62,7 @@ (defvar which-key--setup-p nil "Internal: Non-nil if which-key buffer has been setup") + (define-minor-mode which-key-mode "Toggle which-key-mode." :global t @@ -73,23 +81,26 @@ (concat (substring desc 0 which-key-max-description-length) "..") desc)) -(defun which-key/format-matches (key-desc-cons max-len-key max-len-desc) +(defun which-key/format-matches (unformatted max-len-key max-len-desc) "Turn `key-desc-cons' into formatted strings (including text properties), and pad with spaces so that all are a uniform length." - (let* ((key (car key-desc-cons)) - (desc (cdr key-desc-cons)) - (group (string-match-p "^group:" desc)) - (prefix (string-match-p "^Prefix" desc)) - (desc-face (if (or prefix group) - 'font-lock-keyword-face 'font-lock-function-name-face)) - (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc))) - (key-padding (s-repeat (- max-len-key (length key)) " ")) - (padded-desc (s-pad-right max-len-desc " " tmp-desc))) - (format (concat (propertize "[" 'face 'font-lock-comment-face) "%s" - (propertize "]" 'face 'font-lock-comment-face) "%s" - (propertize " %s" 'face desc-face)) - key key-padding padded-desc))) + (mapcar + (lambda (key-desc-cons) + (let* ((key (car key-desc-cons)) + (desc (cdr key-desc-cons)) + (group (string-match-p "^group:" desc)) + (prefix (string-match-p "^Prefix" desc)) + (desc-face (if (or prefix group) + 'font-lock-keyword-face 'font-lock-function-name-face)) + (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc))) + (key-padding (s-repeat (- max-len-key (length key)) " ")) + (padded-desc (s-pad-right max-len-desc " " tmp-desc))) + (format (concat (propertize "[" 'face 'font-lock-comment-face) "%s" + (propertize "]" 'face 'font-lock-comment-face) "%s" + (propertize " %s" 'face desc-face)) + key key-padding padded-desc))) + unformatted)) (defun which-key/replace-strings-from-alist (replacements) "Find and replace text in buffer according to REPLACEMENTS, @@ -104,16 +115,45 @@ replace and the cdr is the replacement text. " (setq old-face (get-text-property (match-beginning 0) 'face)) (replace-match (propertize (cdr rep) 'face old-face) nil t)))))) -(defun which-key/get-vertical-buffer-width (max-len-key max-len-desc) - (min which-key-vertical-buffer-width (+ 3 max-len-desc max-len-key))) +(defun which-key/buffer-width (max-len-key max-len-desc sel-window-width) + (cond ((and (eq which-key-buffer-display-function 'display-buffer-in-side-window) + (member which-key-buffer-position '(left right))) + (min which-key-vertical-buffer-width (+ 3 max-len-desc max-len-key))) + ((eq which-key-buffer-display-function 'display-buffer-in-side-window) + (frame-width)) + ((eq which-key-buffer-display-function 'display-buffer-below-selected) + sel-window-width) + (t nil))) + +(defsubst which-key/buffer-height (line-breaks) (+ 2 line-breaks)) + +;; (defun which-key/window-params-alist (max-len-key max-len-desc line-breaks selected-buf) +;; (let ((disp-func which-key-buffer-display-function) +;; (position which-key-buffer-position) +;; (selected-window (buffer-w)) +;; width height side) +;; (cond +;; ((and (eq disp-func 'display-buffer-in-side-window) +;; (member position '(left right))) +;; (setq width (which-key/vertical-buffer-width max-len-desc max-len-key) +;; height (frame-height) +;; side position)) +;; ((eq disp-func 'display-buffer-in-side-window) +;; (setq width (frame-width) +;; height (+ 2 line-breaks) +;; side position)) +;; ((eq disp-func 'display-buffer-below-selected) +;; (setq height (+ 2 line-breaks))) +;; (t (error "error: Using unsupported buffer display function"))) +;; (list (when width (cons 'window-width width)) +;; (cons 'window-height height) +;; (when side (cons 'side side))))) -(defun which-key/insert-keys (formatted-strings vertical-buffer-width) +(defun which-key/insert-keys (formatted-strings buffer-width) "Insert strings into buffer breaking after `which-key-buffer-width'." (let ((char-count 0) (line-breaks 0) - (width (if vertical-buffer-width - vertical-buffer-width - (frame-width)))) + (width (if buffer-width buffer-width (frame-width)))) (insert (mapconcat (lambda (str) (let* ((str-len (length (substring-no-properties str))) @@ -134,19 +174,22 @@ Finally, show the buffer." (progn (when which-key--close-timer (cancel-timer which-key--close-timer)) (which-key/hide-buffer) - (let ((buf (current-buffer)) + (let ((buf (current-buffer)) (win-width (window-width)) (key-str-qt (regexp-quote (key-description key))) (bottom-or-top (member which-key-buffer-position '(top bottom))) - (max-len-key 0) (max-len-desc 0) key-match desc-match - unformatted formatted buffer-height buffer-width vertical-buffer-width) + (max-len-key 0) (max-len-desc 0) + key-match desc-match unformatted formatted buffer-width + line-breaks) ;; get keybindings (with-temp-buffer (describe-buffer-bindings buf key) (goto-char (point-max)) (while (re-search-backward - (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt) + (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" + key-str-qt) nil t) - (setq key-match (s-replace-all which-key-key-replacement-alist (match-string 1)) + (setq key-match (s-replace-all + which-key-key-replacement-alist (match-string 1)) desc-match (match-string 2) max-len-key (max max-len-key (length key-match)) max-len-desc (max max-len-desc (length desc-match))) @@ -154,23 +197,24 @@ Finally, show the buffer." :test (lambda (x y) (string-equal (car x) (car y))))) (setq max-len-desc (if (> max-len-desc which-key-max-description-length) (+ 2 which-key-max-description-length) ; for the .. - max-len-desc)) - (setq formatted (mapcar (lambda (str) - (which-key/format-matches str max-len-key max-len-desc)) - unformatted))) + max-len-desc) + formatted (which-key/format-matches + unformatted max-len-key max-len-desc))) (with-current-buffer (get-buffer which-key--buffer) (erase-buffer) - (setq vertical-buffer-width - (which-key/get-vertical-buffer-width max-len-desc max-len-key) - buffer-line-breaks - (which-key/insert-keys formatted (unless bottom-or-top vertical-buffer-width))) + (setq buffer-width (which-key/buffer-width + max-len-key max-len-desc win-width) + line-breaks (which-key/insert-keys + formatted buffer-width)) (goto-char (point-min)) - (which-key/replace-strings-from-alist which-key-general-replacement-alist) - (if bottom-or-top - (setq buffer-height (+ 2 buffer-line-breaks)) - (setq buffer-width vertical-buffer-width))) - (setq which-key--window (which-key/show-buffer buffer-height buffer-width)) - (setq which-key--close-timer (run-at-time which-key-close-buffer-idle-delay nil 'which-key/hide-buffer)))) + (which-key/replace-strings-from-alist + which-key-general-replacement-alist)) + (setq which-key--window (which-key/show-buffer + (which-key/buffer-height line-breaks) + buffer-width)) + (setq which-key--close-timer (run-at-time + which-key-close-buffer-idle-delay + nil 'which-key/hide-buffer)))) ;; close the window (when (window-live-p which-key--window) (which-key/hide-buffer))))) @@ -187,10 +231,12 @@ Finally, show the buffer." ;; :position which-key-buffer-position)) (defun which-key/show-buffer (height width) - (setq alist (list (cons 'side which-key-buffer-position) - (when height (cons 'window-height height)) - (when width (cons 'window-width width)))) - (display-buffer "*which-key*" (cons 'display-buffer-in-side-window alist))) + (let ((side which-key-buffer-position) alist) + (setq alist (list (when side (cons 'side side)) + (when height (cons 'window-height height)) + (when width (cons 'window-width width)))) + (message "h: %s w: %s s: %s" height width side) + (display-buffer "*which-key*" (cons which-key-buffer-display-function alist)))) (defun which-key/hide-buffer () "Like it says :\)" commit ada5cfda1cb1bbc21f67b43d4182e85282102ec1 Author: Justin Burkett Date: Thu Jul 2 20:05:01 2015 -0400 Declare `which-key--close-timer' diff --git a/which-key.el b/which-key.el index 968bcbce252..28026641d1c 100644 --- a/which-key.el +++ b/which-key.el @@ -50,6 +50,8 @@ "Internal: Holds reference to which-key window.") (defvar which-key--timer nil "Internal: Holds reference to timer.") +(defvar which-key--close-timer nil + "Internal: Holds reference to close window timer.") (defvar which-key--setup-p nil "Internal: Non-nil if which-key buffer has been setup") commit 515ed1df9607c6cbd653b9b97ee04a464db59251 Author: Justin Burkett Date: Thu Jul 2 19:28:36 2015 -0400 Fix close timer randomly kicking in when you take too long to decide diff --git a/which-key.el b/which-key.el index d00f3c5421a..968bcbce252 100644 --- a/which-key.el +++ b/which-key.el @@ -130,6 +130,8 @@ Finally, show the buffer." (let ((key (this-single-command-keys))) (if (> (length key) 0) (progn + (when which-key--close-timer (cancel-timer which-key--close-timer)) + (which-key/hide-buffer) (let ((buf (current-buffer)) (key-str-qt (regexp-quote (key-description key))) (bottom-or-top (member which-key-buffer-position '(top bottom))) commit d57fca695d6efaaa264368f7909a134857b2e1c2 Author: Justin Burkett Date: Thu Jul 2 19:08:15 2015 -0400 Fix text replacement alist Conflicts: which-key.el diff --git a/which-key.el b/which-key.el index bec94a768e9..ff437e83ae8 100644 --- a/which-key.el +++ b/which-key.el @@ -32,10 +32,10 @@ '((">". "") ("<" . "") ("left" ."←") ("right" . "→")) "The strings in the car of each cons cell are replaced with the strings in the cdr for each key.") -(defvar which-key-description-replacement-alist nil +(defvar which-key-general-replacement-alist nil "See `which-key-key-replacement-alist'. This is a list of cons - cells for replacing the description of keys (usually the name - of the corresponding function).") + cells for replacing any text, keys and descriptions. You can + also use elisp regexp in the car of the cells.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-buffer-position 'bottom @@ -92,9 +92,13 @@ length." which is an alist where the car of each element is the text to replace and the cdr is the replacement text. " (dolist (rep replacements) - (save-excursion - (while (search-forward (car rep) nil t) - (replace-match (cdr rep) nil t))))) + (let ((trunc-car (which-key/truncate-description (car rep))) + old-face) + (save-excursion + (while (or (search-forward (car rep) nil t) + (search-forward trunc-car nil t)) + (setq old-face (get-text-property (match-beginning 0) 'face)) + (replace-match (propertize (cdr rep) 'face old-face) nil t)))))) (defun which-key/get-vertical-buffer-width (max-len-key max-len-desc) (min which-key-vertical-buffer-width (+ 3 max-len-desc max-len-key))) @@ -148,11 +152,12 @@ replace and the cdr is the replacement text. " unformatted))) (with-current-buffer (get-buffer which-key--buffer) (erase-buffer) - (setq vertical-buffer-width (which-key/get-vertical-buffer-width max-len-desc max-len-key)) - (setq buffer-line-breaks + (setq vertical-buffer-width + (which-key/get-vertical-buffer-width max-len-desc max-len-key) + buffer-line-breaks (which-key/insert-keys formatted (unless bottom-or-top vertical-buffer-width))) (goto-char (point-min)) - (which-key/replace-strings-from-alist which-key-description-replacement-alist) + (which-key/replace-strings-from-alist which-key-general-replacement-alist) (if bottom-or-top (setq buffer-height (+ 2 buffer-line-breaks)) (setq buffer-width vertical-buffer-width))) commit b353cd2a35d91bb5209687e1ce9e217fce34ef0a Author: Justin Burkett Date: Thu Jul 2 19:08:15 2015 -0400 Fix text replacement alist diff --git a/which-key.el b/which-key.el index b59b1a74c70..d00f3c5421a 100644 --- a/which-key.el +++ b/which-key.el @@ -32,10 +32,10 @@ '((">". "") ("<" . "") ("left" ."←") ("right" . "→")) "The strings in the car of each cons cell are replaced with the strings in the cdr for each key.") -(defvar which-key-description-replacement-alist nil +(defvar which-key-general-replacement-alist nil "See `which-key-key-replacement-alist'. This is a list of cons - cells for replacing the description of keys (usually the name - of the corresponding function).") + cells for replacing any text, keys and descriptions. You can + also use elisp regexp in the car of the cells.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-buffer-position 'bottom @@ -94,9 +94,13 @@ length." which is an alist where the car of each element is the text to replace and the cdr is the replacement text. " (dolist (rep replacements) - (save-excursion - (while (search-forward (car rep) nil t) - (replace-match (cdr rep) nil t))))) + (let ((trunc-car (which-key/truncate-description (car rep))) + old-face) + (save-excursion + (while (or (search-forward (car rep) nil t) + (search-forward trunc-car nil t)) + (setq old-face (get-text-property (match-beginning 0) 'face)) + (replace-match (propertize (cdr rep) 'face old-face) nil t)))))) (defun which-key/get-vertical-buffer-width (max-len-key max-len-desc) (min which-key-vertical-buffer-width (+ 3 max-len-desc max-len-key))) @@ -152,11 +156,12 @@ Finally, show the buffer." unformatted))) (with-current-buffer (get-buffer which-key--buffer) (erase-buffer) - (setq vertical-buffer-width (which-key/get-vertical-buffer-width max-len-desc max-len-key) + (setq vertical-buffer-width + (which-key/get-vertical-buffer-width max-len-desc max-len-key) buffer-line-breaks (which-key/insert-keys formatted (unless bottom-or-top vertical-buffer-width))) (goto-char (point-min)) - (which-key/replace-strings-from-alist which-key-description-replacement-alist) + (which-key/replace-strings-from-alist which-key-general-replacement-alist) (if bottom-or-top (setq buffer-height (+ 2 buffer-line-breaks)) (setq buffer-width vertical-buffer-width))) commit 94d5fd571c50f59938f114f52e4c43e3263b3932 Author: Justin Burkett Date: Thu Jul 2 18:14:04 2015 -0400 Switch from popwin to display-buffer diff --git a/which-key.el b/which-key.el index bec94a768e9..b59b1a74c70 100644 --- a/which-key.el +++ b/which-key.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/justbur/which-key/ ;; Version: 0.1 ;; Keywords: -;; Package-Requires: ((s "1.9.0") (popwin "1.0.0")) +;; Package-Requires: ((s "1.9.0")) ;;; Commentary: ;; @@ -46,6 +46,8 @@ ;; Internal Vars (defvar which-key--buffer nil "Internal: Holds reference to which-key buffer.") +(defvar which-key--window nil + "Internal: Holds reference to which-key window.") (defvar which-key--timer nil "Internal: Holds reference to timer.") (defvar which-key--setup-p nil @@ -55,7 +57,7 @@ "Toggle which-key-mode." :global t :lighter " WK" - :require 'popwin + ;; :require 'popwin :require 's (funcall (if which-key-mode (progn @@ -119,62 +121,72 @@ replace and the cdr is the replacement text. " line-breaks)) (defun which-key/update-buffer-and-show () - "Fill which-key--buffer with key descriptions and reformat. Finally, show the buffer." + "Fill which-key--buffer with key descriptions and reformat. +Finally, show the buffer." (let ((key (this-single-command-keys))) - (when (> (length key) 0) - (let ((buf (current-buffer)) - (key-str-qt (regexp-quote (key-description key))) - (bottom-or-top (member which-key-buffer-position '(top bottom))) - (max-len-key 0) (max-len-desc 0) key-match desc-match - unformatted formatted buffer-height buffer-width vertical-buffer-width) - ;; get keybindings - (with-temp-buffer - (describe-buffer-bindings buf key) - (goto-char (point-max)) - (while (re-search-backward - (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt) - nil t) - (setq key-match (s-replace-all which-key-key-replacement-alist (match-string 1)) - desc-match (match-string 2) - max-len-key (max max-len-key (length key-match)) - max-len-desc (max max-len-desc (length desc-match))) - (cl-pushnew (cons key-match desc-match) unformatted - :test (lambda (x y) (string-equal (car x) (car y))))) - (setq max-len-desc (if (> max-len-desc which-key-max-description-length) - (+ 2 which-key-max-description-length) ; for the .. - max-len-desc)) - (setq formatted (mapcar (lambda (str) - (which-key/format-matches str max-len-key max-len-desc)) - unformatted))) - (with-current-buffer (get-buffer which-key--buffer) - (erase-buffer) - (setq vertical-buffer-width (which-key/get-vertical-buffer-width max-len-desc max-len-key)) - (setq buffer-line-breaks - (which-key/insert-keys formatted (unless bottom-or-top vertical-buffer-width))) - (goto-char (point-min)) - (which-key/replace-strings-from-alist which-key-description-replacement-alist) - (if bottom-or-top - (setq buffer-height (+ 2 buffer-line-breaks)) - (setq buffer-width vertical-buffer-width))) - (which-key/show-buffer buffer-height buffer-width) - (run-at-time which-key-close-buffer-idle-delay nil 'which-key/hide-buffer))))) + (if (> (length key) 0) + (progn + (let ((buf (current-buffer)) + (key-str-qt (regexp-quote (key-description key))) + (bottom-or-top (member which-key-buffer-position '(top bottom))) + (max-len-key 0) (max-len-desc 0) key-match desc-match + unformatted formatted buffer-height buffer-width vertical-buffer-width) + ;; get keybindings + (with-temp-buffer + (describe-buffer-bindings buf key) + (goto-char (point-max)) + (while (re-search-backward + (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt) + nil t) + (setq key-match (s-replace-all which-key-key-replacement-alist (match-string 1)) + desc-match (match-string 2) + max-len-key (max max-len-key (length key-match)) + max-len-desc (max max-len-desc (length desc-match))) + (cl-pushnew (cons key-match desc-match) unformatted + :test (lambda (x y) (string-equal (car x) (car y))))) + (setq max-len-desc (if (> max-len-desc which-key-max-description-length) + (+ 2 which-key-max-description-length) ; for the .. + max-len-desc)) + (setq formatted (mapcar (lambda (str) + (which-key/format-matches str max-len-key max-len-desc)) + unformatted))) + (with-current-buffer (get-buffer which-key--buffer) + (erase-buffer) + (setq vertical-buffer-width (which-key/get-vertical-buffer-width max-len-desc max-len-key) + buffer-line-breaks + (which-key/insert-keys formatted (unless bottom-or-top vertical-buffer-width))) + (goto-char (point-min)) + (which-key/replace-strings-from-alist which-key-description-replacement-alist) + (if bottom-or-top + (setq buffer-height (+ 2 buffer-line-breaks)) + (setq buffer-width vertical-buffer-width))) + (setq which-key--window (which-key/show-buffer buffer-height buffer-width)) + (setq which-key--close-timer (run-at-time which-key-close-buffer-idle-delay nil 'which-key/hide-buffer)))) + ;; close the window + (when (window-live-p which-key--window) (which-key/hide-buffer))))) (defun which-key/setup () "Create buffer for which-key." (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (setq which-key--setup-p t)) +;; (defun which-key/show-buffer-popwin (height width) +;; (popwin:popup-buffer which-key-buffer-name +;; :width width +;; :height height +;; :noselect t +;; :position which-key-buffer-position)) + (defun which-key/show-buffer (height width) - (popwin:popup-buffer which-key-buffer-name - :width width - :height height - :noselect t - :position which-key-buffer-position)) + (setq alist (list (cons 'side which-key-buffer-position) + (when height (cons 'window-height height)) + (when width (cons 'window-width width)))) + (display-buffer "*which-key*" (cons 'display-buffer-in-side-window alist))) (defun which-key/hide-buffer () "Like it says :\)" - (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) - (popwin:close-popup-window))) + (when (window-live-p which-key--window) + (delete-window which-key--window))) (defun which-key/turn-on-timer () "Activate idle timer." commit 04708f29d836a6621138b12ee300ddbaab13d346 Author: Justin Burkett Date: Thu Jul 2 11:41:59 2015 -0400 Start working on MELPA requirements diff --git a/which-key.el b/which-key.el index 968a52c7a24..bec94a768e9 100644 --- a/which-key.el +++ b/which-key.el @@ -3,14 +3,20 @@ ;; Copyright (C) 2015 Justin Burkett ;; Author: Justin Burkett -;; URL: http://github.com/justbur/which-key/ +;; URL: https://github.com/justbur/which-key/ ;; Version: 0.1 ;; Keywords: -;; Package-Requires: ((s "1.9.0")) +;; Package-Requires: ((s "1.9.0") (popwin "1.0.0")) ;;; Commentary: ;; -;; Rewrite of guide-key-mode. +;; This is a rewrite of guide-key https://github.com/kai2nenobu/guide-key +;; with the following goals: +;; +;; 1. Remove polling function for performance reasons +;; 2. Try to simplify code as much as possible +;; 3. Switch away from using popwin (planned) +;; 4. Add replacement strings to create "aliases" for functions. ;; ;;; Code: @@ -181,3 +187,4 @@ replace and the cdr is the replacement text. " (provide 'which-key) +;;; which-key.el ends here commit a9c54a458afb5cbb150c441f5ef489d617f1f5e0 Author: Justin Burkett Date: Thu Jul 2 09:19:48 2015 -0400 Add provide line diff --git a/which-key.el b/which-key.el index 0588d170086..968a52c7a24 100644 --- a/which-key.el +++ b/which-key.el @@ -179,3 +179,5 @@ replace and the cdr is the replacement text. " "Deactivate idle timer." (cancel-timer which-key--timer)) +(provide 'which-key) + commit e2f76653de61f174202776ea18b835a8dbdcab31 Author: Justin Burkett Date: Thu Jul 2 08:55:14 2015 -0400 Fix variable names diff --git a/which-key.el b/which-key.el index 56e4a3ed322..0588d170086 100644 --- a/which-key.el +++ b/which-key.el @@ -53,7 +53,7 @@ :require 's (funcall (if which-key-mode (progn - (unless which-key-setup-p (which-key/setup)) + (unless which-key--setup-p (which-key/setup)) 'which-key/turn-on-timer) 'which-key/turn-off-timer))) @@ -77,7 +77,7 @@ length." (key-padding (s-repeat (- max-len-key (length key)) " ")) (padded-desc (s-pad-right max-len-desc " " tmp-desc))) (format (concat (propertize "[" 'face 'font-lock-comment-face) "%s" - (propertize "]%s" 'face 'font-lock-comment-face) + (propertize "]" 'face 'font-lock-comment-face) "%s" (propertize " %s" 'face desc-face)) key key-padding padded-desc))) @@ -156,7 +156,7 @@ replace and the cdr is the replacement text. " (defun which-key/setup () "Create buffer for which-key." (setq which-key--buffer (get-buffer-create which-key-buffer-name)) - (setq which-key-setup-p t)) + (setq which-key--setup-p t)) (defun which-key/show-buffer (height width) (popwin:popup-buffer which-key-buffer-name commit 56bc8983e77f3ce0a30c69b012fbc96971dbed74 Author: Justin Burkett Date: Thu Jul 2 08:36:54 2015 -0400 Make internal variables stand out diff --git a/which-key.el b/which-key.el index b3ca76f5232..56e4a3ed322 100644 --- a/which-key.el +++ b/which-key.el @@ -15,11 +15,9 @@ ;;; Code: -(defvar which-key-timer nil - "Internal variable to hold reference to timer.") -(defvar which-key-idle-delay 0.5 +(defvar which-key-idle-delay 0.6 "Delay (in seconds) for which-key buffer to popup.") -(defvar which-key-close-buffer-idle-delay 5 +(defvar which-key-close-buffer-idle-delay 4 "Delay (in seconds) after which buffer is forced closed.") (defvar which-key-max-description-length 30 "Truncate the description of keys to this length (adds @@ -32,9 +30,6 @@ "See `which-key-key-replacement-alist'. This is a list of cons cells for replacing the description of keys (usually the name of the corresponding function).") - -(defvar which-key-buffer nil - "Internal variable to hold reference to which-key buffer.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") (defvar which-key-buffer-position 'bottom @@ -42,8 +37,13 @@ (defvar which-key-vertical-buffer-width 60 "Width of which-key buffer .") -(defvar which-key-setup-p nil - "Non-nil if which-key buffer has been setup") +;; Internal Vars +(defvar which-key--buffer nil + "Internal: Holds reference to which-key buffer.") +(defvar which-key--timer nil + "Internal: Holds reference to timer.") +(defvar which-key--setup-p nil + "Internal: Non-nil if which-key buffer has been setup") (define-minor-mode which-key-mode "Toggle which-key-mode." @@ -113,7 +113,7 @@ replace and the cdr is the replacement text. " line-breaks)) (defun which-key/update-buffer-and-show () - "Fill which-key-buffer with key descriptions and reformat. Finally, show the buffer." + "Fill which-key--buffer with key descriptions and reformat. Finally, show the buffer." (let ((key (this-single-command-keys))) (when (> (length key) 0) (let ((buf (current-buffer)) @@ -140,7 +140,7 @@ replace and the cdr is the replacement text. " (setq formatted (mapcar (lambda (str) (which-key/format-matches str max-len-key max-len-desc)) unformatted))) - (with-current-buffer (get-buffer which-key-buffer) + (with-current-buffer (get-buffer which-key--buffer) (erase-buffer) (setq vertical-buffer-width (which-key/get-vertical-buffer-width max-len-desc max-len-key)) (setq buffer-line-breaks @@ -155,7 +155,7 @@ replace and the cdr is the replacement text. " (defun which-key/setup () "Create buffer for which-key." - (setq which-key-buffer (get-buffer-create which-key-buffer-name)) + (setq which-key--buffer (get-buffer-create which-key-buffer-name)) (setq which-key-setup-p t)) (defun which-key/show-buffer (height width) @@ -167,15 +167,15 @@ replace and the cdr is the replacement text. " (defun which-key/hide-buffer () "Like it says :\)" - (when (eq popwin:popup-buffer (get-buffer which-key-buffer)) + (when (eq popwin:popup-buffer (get-buffer which-key--buffer)) (popwin:close-popup-window))) (defun which-key/turn-on-timer () "Activate idle timer." - (setq which-key-timer + (setq which-key--timer (run-with-idle-timer which-key-idle-delay t 'which-key/update-buffer-and-show))) (defun which-key/turn-off-timer () "Deactivate idle timer." - (cancel-timer which-key-timer)) + (cancel-timer which-key--timer)) commit cc95f9125f083df984143a442724ea4ac0eb092f Author: Justin Burkett Date: Thu Jul 2 08:27:29 2015 -0400 Reorganize main update function diff --git a/which-key.el b/which-key.el index c93340891b9..b3ca76f5232 100644 --- a/which-key.el +++ b/which-key.el @@ -121,8 +121,8 @@ replace and the cdr is the replacement text. " (bottom-or-top (member which-key-buffer-position '(top bottom))) (max-len-key 0) (max-len-desc 0) key-match desc-match unformatted formatted buffer-height buffer-width vertical-buffer-width) - (with-current-buffer (get-buffer which-key-buffer) - (erase-buffer) + ;; get keybindings + (with-temp-buffer (describe-buffer-bindings buf key) (goto-char (point-max)) (while (re-search-backward @@ -135,18 +135,18 @@ replace and the cdr is the replacement text. " (cl-pushnew (cons key-match desc-match) unformatted :test (lambda (x y) (string-equal (car x) (car y))))) (setq max-len-desc (if (> max-len-desc which-key-max-description-length) - (+ 2 which-key-max-description-length) + (+ 2 which-key-max-description-length) ; for the .. max-len-desc)) (setq formatted (mapcar (lambda (str) (which-key/format-matches str max-len-key max-len-desc)) - unformatted)) + unformatted))) + (with-current-buffer (get-buffer which-key-buffer) (erase-buffer) (setq vertical-buffer-width (which-key/get-vertical-buffer-width max-len-desc max-len-key)) (setq buffer-line-breaks (which-key/insert-keys formatted (unless bottom-or-top vertical-buffer-width))) (goto-char (point-min)) (which-key/replace-strings-from-alist which-key-description-replacement-alist) - ;; (message "%s" which-key-vertical-buffer-width) (if bottom-or-top (setq buffer-height (+ 2 buffer-line-breaks)) (setq buffer-width vertical-buffer-width))) commit 8ce8558de8227b292d40d096e088b3f9abdb9b49 Author: Justin Burkett Date: Thu Jul 2 08:01:23 2015 -0400 Cleanup diff --git a/which-key.el b/which-key.el index 362491425ad..c93340891b9 100644 --- a/which-key.el +++ b/which-key.el @@ -154,12 +154,11 @@ replace and the cdr is the replacement text. " (run-at-time which-key-close-buffer-idle-delay nil 'which-key/hide-buffer))))) (defun which-key/setup () - "Create buffer for which-key and add buffer to `popwin:special-display-config'" + "Create buffer for which-key." (setq which-key-buffer (get-buffer-create which-key-buffer-name)) (setq which-key-setup-p t)) (defun which-key/show-buffer (height width) - ;; (message "w: %s h: %s" width height) (popwin:popup-buffer which-key-buffer-name :width width :height height commit 24b665c59af8dcf8ba1bbab54108fc3c5535d7a5 Author: Justin Burkett Date: Wed Jul 1 22:42:42 2015 -0400 Less rough now diff --git a/README.md b/README.md index 64c2091b999..6f77947c0d8 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # emacs-which-key Rewrite of guide-key-mode for emacs. -It's very, very rough right now. +It's very rough right now. Planned features: 1. Simplify code, especially the trigger mechanism to make it less resource commit 152ee1967b76c8e3d87dd2583e5bef33288c5549 Author: Justin Burkett Date: Wed Jul 1 22:41:22 2015 -0400 Add option to force buffer closed after certain amount of time diff --git a/which-key.el b/which-key.el index 65a7bd00cb3..362491425ad 100644 --- a/which-key.el +++ b/which-key.el @@ -20,7 +20,7 @@ (defvar which-key-idle-delay 0.5 "Delay (in seconds) for which-key buffer to popup.") (defvar which-key-close-buffer-idle-delay 5 - "Delay (in seconds) for which-key buffer to show.") + "Delay (in seconds) after which buffer is forced closed.") (defvar which-key-max-description-length 30 "Truncate the description of keys to this length (adds \"..\")") @@ -150,7 +150,8 @@ replace and the cdr is the replacement text. " (if bottom-or-top (setq buffer-height (+ 2 buffer-line-breaks)) (setq buffer-width vertical-buffer-width))) - (which-key/show-buffer buffer-height buffer-width))))) + (which-key/show-buffer buffer-height buffer-width) + (run-at-time which-key-close-buffer-idle-delay nil 'which-key/hide-buffer))))) (defun which-key/setup () "Create buffer for which-key and add buffer to `popwin:special-display-config'" @@ -165,6 +166,11 @@ replace and the cdr is the replacement text. " :noselect t :position which-key-buffer-position)) +(defun which-key/hide-buffer () + "Like it says :\)" + (when (eq popwin:popup-buffer (get-buffer which-key-buffer)) + (popwin:close-popup-window))) + (defun which-key/turn-on-timer () "Activate idle timer." (setq which-key-timer commit 6812f74d942f4d486d699a0da9a7d001ba42f3e8 Author: Justin Burkett Date: Wed Jul 1 22:31:02 2015 -0400 Fix vertical buffer width I think diff --git a/which-key.el b/which-key.el index 530493f795d..65a7bd00cb3 100644 --- a/which-key.el +++ b/which-key.el @@ -19,6 +19,8 @@ "Internal variable to hold reference to timer.") (defvar which-key-idle-delay 0.5 "Delay (in seconds) for which-key buffer to popup.") +(defvar which-key-close-buffer-idle-delay 5 + "Delay (in seconds) for which-key buffer to show.") (defvar which-key-max-description-length 30 "Truncate the description of keys to this length (adds \"..\")") @@ -37,7 +39,7 @@ "Name of which-key buffer.") (defvar which-key-buffer-position 'bottom "Position of which-key buffer") -(defvar which-key-vertical-buffer-width 80 +(defvar which-key-vertical-buffer-width 60 "Width of which-key buffer .") (defvar which-key-setup-p nil @@ -88,11 +90,16 @@ replace and the cdr is the replacement text. " (while (search-forward (car rep) nil t) (replace-match (cdr rep) nil t))))) -(defun which-key/insert-keys (formatted-strings bottom-or-top) +(defun which-key/get-vertical-buffer-width (max-len-key max-len-desc) + (min which-key-vertical-buffer-width (+ 3 max-len-desc max-len-key))) + +(defun which-key/insert-keys (formatted-strings vertical-buffer-width) "Insert strings into buffer breaking after `which-key-buffer-width'." (let ((char-count 0) (line-breaks 0) - (width (if bottom-or-top (frame-width) which-key-vertical-buffer-width))) + (width (if vertical-buffer-width + vertical-buffer-width + (frame-width)))) (insert (mapconcat (lambda (str) (let* ((str-len (length (substring-no-properties str))) @@ -112,34 +119,37 @@ replace and the cdr is the replacement text. " (let ((buf (current-buffer)) (key-str-qt (regexp-quote (key-description key))) (bottom-or-top (member which-key-buffer-position '(top bottom))) - unformatted formatted buffer-height buffer-width) + (max-len-key 0) (max-len-desc 0) key-match desc-match + unformatted formatted buffer-height buffer-width vertical-buffer-width) (with-current-buffer (get-buffer which-key-buffer) (erase-buffer) (describe-buffer-bindings buf key) (goto-char (point-max)) - (let ((max-len-key 0) (max-len-desc 0) key-match desc-match) - (while (re-search-backward - (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt) - nil t) - (setq key-match (s-replace-all which-key-key-replacement-alist (match-string 1)) - desc-match (match-string 2) - max-len-key (max max-len-key (length key-match)) - max-len-desc (max max-len-desc (length desc-match))) - (cl-pushnew (cons key-match desc-match) unformatted - :test (lambda (x y) (string-equal (car x) (car y))))) - (setq max-len-desc (if (> max-len-desc which-key-max-description-length) - (+ 2 which-key-max-description-length) - max-len-desc)) - (setq formatted (mapcar (lambda (str) - (which-key/format-matches str max-len-key max-len-desc)) - unformatted))) + (while (re-search-backward + (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt) + nil t) + (setq key-match (s-replace-all which-key-key-replacement-alist (match-string 1)) + desc-match (match-string 2) + max-len-key (max max-len-key (length key-match)) + max-len-desc (max max-len-desc (length desc-match))) + (cl-pushnew (cons key-match desc-match) unformatted + :test (lambda (x y) (string-equal (car x) (car y))))) + (setq max-len-desc (if (> max-len-desc which-key-max-description-length) + (+ 2 which-key-max-description-length) + max-len-desc)) + (setq formatted (mapcar (lambda (str) + (which-key/format-matches str max-len-key max-len-desc)) + unformatted)) (erase-buffer) - (setq buffer-line-breaks (which-key/insert-keys formatted bottom-or-top)) + (setq vertical-buffer-width (which-key/get-vertical-buffer-width max-len-desc max-len-key)) + (setq buffer-line-breaks + (which-key/insert-keys formatted (unless bottom-or-top vertical-buffer-width))) (goto-char (point-min)) (which-key/replace-strings-from-alist which-key-description-replacement-alist) + ;; (message "%s" which-key-vertical-buffer-width) (if bottom-or-top (setq buffer-height (+ 2 buffer-line-breaks)) - (setq buffer-width (* which-key-max-description-length (char-width))))) + (setq buffer-width vertical-buffer-width))) (which-key/show-buffer buffer-height buffer-width))))) (defun which-key/setup () commit 3f2a289743b960055fa4b0f7af8615d2080a9495 Author: Justin Burkett Date: Wed Jul 1 22:01:36 2015 -0400 Improve choice of buffer width and height diff --git a/which-key.el b/which-key.el index 03620510c41..530493f795d 100644 --- a/which-key.el +++ b/which-key.el @@ -35,10 +35,10 @@ "Internal variable to hold reference to which-key buffer.") (defvar which-key-buffer-name "*which-key*" "Name of which-key buffer.") -(defvar which-key-buffer-position 'right +(defvar which-key-buffer-position 'bottom "Position of which-key buffer") -(defvar which-key-buffer-width 80 - "Width of which-key buffer (hardcoded for now).") +(defvar which-key-vertical-buffer-width 80 + "Width of which-key buffer .") (defvar which-key-setup-p nil "Non-nil if which-key buffer has been setup") @@ -88,18 +88,22 @@ replace and the cdr is the replacement text. " (while (search-forward (car rep) nil t) (replace-match (cdr rep) nil t))))) -(defun which-key/insert-keys (formatted-strings) +(defun which-key/insert-keys (formatted-strings bottom-or-top) "Insert strings into buffer breaking after `which-key-buffer-width'." - (let ((char-count 0)) + (let ((char-count 0) + (line-breaks 0) + (width (if bottom-or-top (frame-width) which-key-vertical-buffer-width))) (insert (mapconcat (lambda (str) (let* ((str-len (length (substring-no-properties str))) (new-count (+ char-count str-len))) - (if (> new-count which-key-buffer-width) + (if (> new-count width) (progn (setq char-count str-len) + (cl-incf line-breaks) (concat "\n" str)) (setq char-count new-count) - str))) formatted-strings "")))) + str))) formatted-strings "")) + line-breaks)) (defun which-key/update-buffer-and-show () "Fill which-key-buffer with key descriptions and reformat. Finally, show the buffer." @@ -107,7 +111,8 @@ replace and the cdr is the replacement text. " (when (> (length key) 0) (let ((buf (current-buffer)) (key-str-qt (regexp-quote (key-description key))) - unformatted formatted) + (bottom-or-top (member which-key-buffer-position '(top bottom))) + unformatted formatted buffer-height buffer-width) (with-current-buffer (get-buffer which-key-buffer) (erase-buffer) (describe-buffer-bindings buf key) @@ -129,21 +134,27 @@ replace and the cdr is the replacement text. " (which-key/format-matches str max-len-key max-len-desc)) unformatted))) (erase-buffer) - (which-key/insert-keys formatted) + (setq buffer-line-breaks (which-key/insert-keys formatted bottom-or-top)) (goto-char (point-min)) - (which-key/replace-strings-from-alist which-key-description-replacement-alist))) - (display-buffer which-key-buffer)))) + (which-key/replace-strings-from-alist which-key-description-replacement-alist) + (if bottom-or-top + (setq buffer-height (+ 2 buffer-line-breaks)) + (setq buffer-width (* which-key-max-description-length (char-width))))) + (which-key/show-buffer buffer-height buffer-width))))) (defun which-key/setup () "Create buffer for which-key and add buffer to `popwin:special-display-config'" (setq which-key-buffer (get-buffer-create which-key-buffer-name)) - (add-to-list 'popwin:special-display-config - `(,which-key-buffer-name - :width ,which-key-buffer-width - :noselect t - :position ,which-key-buffer-position)) (setq which-key-setup-p t)) +(defun which-key/show-buffer (height width) + ;; (message "w: %s h: %s" width height) + (popwin:popup-buffer which-key-buffer-name + :width width + :height height + :noselect t + :position which-key-buffer-position)) + (defun which-key/turn-on-timer () "Activate idle timer." (setq which-key-timer commit 26e5c38cb797ffc38f76d63f22ab26121cda2b63 Author: Justin Burkett Date: Wed Jul 1 21:10:55 2015 -0400 Create README.md diff --git a/README.md b/README.md new file mode 100644 index 00000000000..64c2091b999 --- /dev/null +++ b/README.md @@ -0,0 +1,10 @@ +# emacs-which-key +Rewrite of guide-key-mode for emacs. + +It's very, very rough right now. + +Planned features: + 1. Simplify code, especially the trigger mechanism to make it less resource + intensive than guide-key. + 2. Add option to replace descriptions of keys on the fly. + 3. Switch from using popwin to window-purpose. commit 96a7bb9559d3eaec730b6e84b217c3343c88aeb8 Author: Justin Burkett Date: Wed Jul 1 21:07:09 2015 -0400 Add docstrings diff --git a/which-key.el b/which-key.el index 92333c33522..03620510c41 100644 --- a/which-key.el +++ b/which-key.el @@ -15,22 +15,36 @@ ;;; Code: -(defvar which-key-timer nil) -(defvar which-key-idle-delay 0.5) -(defvar which-key-max-description-length 30) -(defvar which-key-description-replacement-alist nil) +(defvar which-key-timer nil + "Internal variable to hold reference to timer.") +(defvar which-key-idle-delay 0.5 + "Delay (in seconds) for which-key buffer to popup.") +(defvar which-key-max-description-length 30 + "Truncate the description of keys to this length (adds + \"..\")") (defvar which-key-key-replacement-alist - '((">". "") ("<" . "") ("left" ."←") ("right" . "→"))) - -(defvar which-key-buffer nil) -(defvar which-key-buffer-name "*which-key*") -(defvar which-key-buffer-position 'right) -(defvar which-key-buffer-width 80) - -(defvar which-key-setup-p nil) + '((">". "") ("<" . "") ("left" ."←") ("right" . "→")) + "The strings in the car of each cons cell are replaced with the + strings in the cdr for each key.") +(defvar which-key-description-replacement-alist nil + "See `which-key-key-replacement-alist'. This is a list of cons + cells for replacing the description of keys (usually the name + of the corresponding function).") + +(defvar which-key-buffer nil + "Internal variable to hold reference to which-key buffer.") +(defvar which-key-buffer-name "*which-key*" + "Name of which-key buffer.") +(defvar which-key-buffer-position 'right + "Position of which-key buffer") +(defvar which-key-buffer-width 80 + "Width of which-key buffer (hardcoded for now).") + +(defvar which-key-setup-p nil + "Non-nil if which-key buffer has been setup") (define-minor-mode which-key-mode - "Toggle which key mode." + "Toggle which-key-mode." :global t :lighter " WK" :require 'popwin @@ -42,11 +56,15 @@ 'which-key/turn-off-timer))) (defsubst which-key/truncate-description (desc) + "Truncate key description to `which-key-max-description-length'." (if (> (length desc) which-key-max-description-length) (concat (substring desc 0 which-key-max-description-length) "..") desc)) (defun which-key/format-matches (key-desc-cons max-len-key max-len-desc) + "Turn `key-desc-cons' into formatted strings (including text +properties), and pad with spaces so that all are a uniform +length." (let* ((key (car key-desc-cons)) (desc (cdr key-desc-cons)) (group (string-match-p "^group:" desc)) @@ -71,19 +89,20 @@ replace and the cdr is the replacement text. " (replace-match (cdr rep) nil t))))) (defun which-key/insert-keys (formatted-strings) + "Insert strings into buffer breaking after `which-key-buffer-width'." (let ((char-count 0)) - (insert - (mapconcat - (lambda (str) - (let* ((str-len (length (substring-no-properties str))) - (new-count (+ char-count str-len))) - (if (> new-count which-key-buffer-width) - (progn (setq char-count str-len) - (concat "\n" str)) - (setq char-count new-count) - str))) formatted-strings "")))) + (insert (mapconcat + (lambda (str) + (let* ((str-len (length (substring-no-properties str))) + (new-count (+ char-count str-len))) + (if (> new-count which-key-buffer-width) + (progn (setq char-count str-len) + (concat "\n" str)) + (setq char-count new-count) + str))) formatted-strings "")))) (defun which-key/update-buffer-and-show () + "Fill which-key-buffer with key descriptions and reformat. Finally, show the buffer." (let ((key (this-single-command-keys))) (when (> (length key) 0) (let ((buf (current-buffer)) @@ -116,6 +135,7 @@ replace and the cdr is the replacement text. " (display-buffer which-key-buffer)))) (defun which-key/setup () + "Create buffer for which-key and add buffer to `popwin:special-display-config'" (setq which-key-buffer (get-buffer-create which-key-buffer-name)) (add-to-list 'popwin:special-display-config `(,which-key-buffer-name @@ -124,17 +144,12 @@ replace and the cdr is the replacement text. " :position ,which-key-buffer-position)) (setq which-key-setup-p t)) -(defun which-key/popup-buffer () - (popwin:popup-buffer (get-buffer-create "*which-key*") - :position which-key-buffer-position - :noselect t - ;; :height which-key/popup-window-size) - :width which-key-buffer-width)) - (defun which-key/turn-on-timer () + "Activate idle timer." (setq which-key-timer (run-with-idle-timer which-key-idle-delay t 'which-key/update-buffer-and-show))) (defun which-key/turn-off-timer () + "Deactivate idle timer." (cancel-timer which-key-timer)) commit 74c331e5b392e604bc0ee2667b0cea68c43ac7de Author: Justin Burkett Date: Wed Jul 1 20:56:18 2015 -0400 Remove hardcoded variables and switch popwin method Use display-buffer with popwin:special-display-config diff --git a/which-key.el b/which-key.el index 29c36fc56c7..92333c33522 100644 --- a/which-key.el +++ b/which-key.el @@ -22,9 +22,13 @@ (defvar which-key-key-replacement-alist '((">". "") ("<" . "") ("left" ."←") ("right" . "→"))) +(defvar which-key-buffer nil) +(defvar which-key-buffer-name "*which-key*") (defvar which-key-buffer-position 'right) (defvar which-key-buffer-width 80) +(defvar which-key-setup-p nil) + (define-minor-mode which-key-mode "Toggle which key mode." :global t @@ -32,7 +36,9 @@ :require 'popwin :require 's (funcall (if which-key-mode - 'which-key/turn-on-timer + (progn + (unless which-key-setup-p (which-key/setup)) + 'which-key/turn-on-timer) 'which-key/turn-off-timer))) (defsubst which-key/truncate-description (desc) @@ -83,7 +89,7 @@ replace and the cdr is the replacement text. " (let ((buf (current-buffer)) (key-str-qt (regexp-quote (key-description key))) unformatted formatted) - (with-current-buffer (get-buffer-create "*which-key*") + (with-current-buffer (get-buffer which-key-buffer) (erase-buffer) (describe-buffer-bindings buf key) (goto-char (point-max)) @@ -107,7 +113,16 @@ replace and the cdr is the replacement text. " (which-key/insert-keys formatted) (goto-char (point-min)) (which-key/replace-strings-from-alist which-key-description-replacement-alist))) - (which-key/popup-buffer)))) + (display-buffer which-key-buffer)))) + +(defun which-key/setup () + (setq which-key-buffer (get-buffer-create which-key-buffer-name)) + (add-to-list 'popwin:special-display-config + `(,which-key-buffer-name + :width ,which-key-buffer-width + :noselect t + :position ,which-key-buffer-position)) + (setq which-key-setup-p t)) (defun which-key/popup-buffer () (popwin:popup-buffer (get-buffer-create "*which-key*") commit 673193d55b10ffd39d43595a81aae17f769da09c Author: Justin Burkett Date: Wed Jul 1 20:19:01 2015 -0400 Initial Commit diff --git a/which-key.el b/which-key.el new file mode 100644 index 00000000000..29c36fc56c7 --- /dev/null +++ b/which-key.el @@ -0,0 +1,125 @@ +;;; which-key.el + +;; Copyright (C) 2015 Justin Burkett + +;; Author: Justin Burkett +;; URL: http://github.com/justbur/which-key/ +;; Version: 0.1 +;; Keywords: +;; Package-Requires: ((s "1.9.0")) + +;;; Commentary: +;; +;; Rewrite of guide-key-mode. +;; + +;;; Code: + +(defvar which-key-timer nil) +(defvar which-key-idle-delay 0.5) +(defvar which-key-max-description-length 30) +(defvar which-key-description-replacement-alist nil) +(defvar which-key-key-replacement-alist + '((">". "") ("<" . "") ("left" ."←") ("right" . "→"))) + +(defvar which-key-buffer-position 'right) +(defvar which-key-buffer-width 80) + +(define-minor-mode which-key-mode + "Toggle which key mode." + :global t + :lighter " WK" + :require 'popwin + :require 's + (funcall (if which-key-mode + 'which-key/turn-on-timer + 'which-key/turn-off-timer))) + +(defsubst which-key/truncate-description (desc) + (if (> (length desc) which-key-max-description-length) + (concat (substring desc 0 which-key-max-description-length) "..") + desc)) + +(defun which-key/format-matches (key-desc-cons max-len-key max-len-desc) + (let* ((key (car key-desc-cons)) + (desc (cdr key-desc-cons)) + (group (string-match-p "^group:" desc)) + (prefix (string-match-p "^Prefix" desc)) + (desc-face (if (or prefix group) + 'font-lock-keyword-face 'font-lock-function-name-face)) + (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc))) + (key-padding (s-repeat (- max-len-key (length key)) " ")) + (padded-desc (s-pad-right max-len-desc " " tmp-desc))) + (format (concat (propertize "[" 'face 'font-lock-comment-face) "%s" + (propertize "]%s" 'face 'font-lock-comment-face) + (propertize " %s" 'face desc-face)) + key key-padding padded-desc))) + +(defun which-key/replace-strings-from-alist (replacements) + "Find and replace text in buffer according to REPLACEMENTS, +which is an alist where the car of each element is the text to +replace and the cdr is the replacement text. " + (dolist (rep replacements) + (save-excursion + (while (search-forward (car rep) nil t) + (replace-match (cdr rep) nil t))))) + +(defun which-key/insert-keys (formatted-strings) + (let ((char-count 0)) + (insert + (mapconcat + (lambda (str) + (let* ((str-len (length (substring-no-properties str))) + (new-count (+ char-count str-len))) + (if (> new-count which-key-buffer-width) + (progn (setq char-count str-len) + (concat "\n" str)) + (setq char-count new-count) + str))) formatted-strings "")))) + +(defun which-key/update-buffer-and-show () + (let ((key (this-single-command-keys))) + (when (> (length key) 0) + (let ((buf (current-buffer)) + (key-str-qt (regexp-quote (key-description key))) + unformatted formatted) + (with-current-buffer (get-buffer-create "*which-key*") + (erase-buffer) + (describe-buffer-bindings buf key) + (goto-char (point-max)) + (let ((max-len-key 0) (max-len-desc 0) key-match desc-match) + (while (re-search-backward + (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt) + nil t) + (setq key-match (s-replace-all which-key-key-replacement-alist (match-string 1)) + desc-match (match-string 2) + max-len-key (max max-len-key (length key-match)) + max-len-desc (max max-len-desc (length desc-match))) + (cl-pushnew (cons key-match desc-match) unformatted + :test (lambda (x y) (string-equal (car x) (car y))))) + (setq max-len-desc (if (> max-len-desc which-key-max-description-length) + (+ 2 which-key-max-description-length) + max-len-desc)) + (setq formatted (mapcar (lambda (str) + (which-key/format-matches str max-len-key max-len-desc)) + unformatted))) + (erase-buffer) + (which-key/insert-keys formatted) + (goto-char (point-min)) + (which-key/replace-strings-from-alist which-key-description-replacement-alist))) + (which-key/popup-buffer)))) + +(defun which-key/popup-buffer () + (popwin:popup-buffer (get-buffer-create "*which-key*") + :position which-key-buffer-position + :noselect t + ;; :height which-key/popup-window-size) + :width which-key-buffer-width)) + +(defun which-key/turn-on-timer () + (setq which-key-timer + (run-with-idle-timer which-key-idle-delay t 'which-key/update-buffer-and-show))) + +(defun which-key/turn-off-timer () + (cancel-timer which-key-timer)) + commit eee44fd998bd10ae6fdc491c184e6c7f80305592 Author: Justin Burkett Date: Wed Jul 1 20:20:55 2015 -0400 Add license diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 00000000000..9cecc1d4669 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + 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 . + +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 +. + + 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 +.