-
Notifications
You must be signed in to change notification settings - Fork 12
/
Copy pathhelm-descbinds.el
391 lines (340 loc) · 14.8 KB
/
helm-descbinds.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
;;; helm-descbinds.el --- A convenient `describe-bindings' with `helm' -*- lexical-binding: t -*-
;; Copyright (C) 2008, 2009, 2010 Taiki SUGAWARA <[email protected]>
;; Copyright (C) 2012, 2013 Michael Markert <[email protected]>
;; Copyright (C) 2013 Daniel Hackney <[email protected]>
;; Copyright (C) 2015, 2016 Michael Heerdegen <[email protected]>
;; Author: Taiki SUGAWARA <[email protected]>
;; URL: https://github.com/emacs-helm/helm-descbinds
;; Keywords: helm, help
;; Version: 1.12
;; Package-Requires: ((helm "1.5"))
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This package is a replacement of `describe-bindings' for Helm.
;; Usage:
;;
;; You can use this package independently from Helm - in particular,
;; you don't need to turn on `helm-mode' to be able to use this. Helm
;; just needs to be installed.
;;
;; Add followings on your .emacs.
;;
;; (require 'helm-descbinds)
;; (helm-descbinds-mode)
;;
;; or use customize to set `helm-descbinds-mode' to t.
;;
;; Now, `describe-bindings' is replaced with `helm-descbinds'. As
;; usual, type `C-h b', or any incomplete key sequence plus C-h , to
;; run `helm-descbinds'. The bindings are presented in a similar way
;; as `describe-bindings ' does, but you can use completion to find
;; the command you searched for and execute it, or view it's
;; documentation.
;;
;; In the Helm completions buffer, you match key bindings with the
;; Helm interface:
;;
;; - When you type RET, the selected candidate command is executed.
;;
;; - When you hit RET on a prefix key, the candidates are narrowed to
;; this prefix
;;
;; - When you type TAB, you can select "Execute", "Describe" or "Find
;; Function" by the menu (i.e. these are the available "actions"
;; and are of course also available via their usual shortcuts).
;;
;; - When you type C-z (aka "persistent action"), the selected
;; command is described without quitting Helm.
;;; Code:
(eval-when-compile (require 'cl-lib)) ;cl-loop
(require 'helm)
(defvar which-key-mode)
(declare-function which-key-mode "ext:which-key.el")
(defgroup helm-descbinds nil
"A convenient `describe-bindings' with `helm'."
:prefix "helm-descbinds-"
:group 'helm)
(defface helm-descbinds-key '((t :box t))
"Face for keys in helm-descbinds.")
(defface helm-descbinds-binding '((t :inherit font-lock-warning-face))
"Face for bindings in helm-descbinds.")
(defcustom helm-descbinds-actions
'(("Execute" . helm-descbinds-action:execute)
("Describe" . helm-descbinds-action:describe)
("Find Function" . helm-descbinds-action:find-func))
"Actions of selected candidate."
:type '(repeat
(cons
:tag "Action"
(string :tag "Name")
(function :tag "Function"))))
(defcustom helm-descbinds-candidate-formatter
#'helm-descbinds-default-candidate-formatter
"Candidate formatter function.
This function will be called with two arguments KEY and BINDING."
:type 'function)
(defcustom helm-descbinds-window-style 'one-window
"Window splitting style."
:type '(choice
(const :tag "One Window" one-window)
(const :tag "Same Window" same-window)
(const :tag "Split Window" split-window)))
(defcustom helm-descbinds-section-order
'("Major Mode Bindings" "Minor Mode Bindings" "Global Bindings")
"A list of section order by name regexp."
:type '(repeat (regexp :tag "Regexp")))
(defcustom helm-descbinds-disable-which-key t
"Prevent using `which-key-mode' and `helm-descbinds-mode' together.
When nil allow using both packages together."
:type 'boolean)
(defvar helm-descbinds-prefix-help
"This is a prefix key, hit RET to see all bindings using this prefix.
A “prefix key” is a key sequence whose binding is a keymap. The keymap
defines what to do with key sequences that extend the prefix key. For
example, ‘C-x’ is a prefix key, and it uses a keymap that is also stored
in the variable ‘ctl-x-map’. This keymap defines bindings for key
sequences starting with ‘C-x’.
See (info \"(elisp) Prefix Keys\") for more infos."
"A brief documentation of what is a prefix key.
This string is extracted from Elisp manual,
see (info \"(elisp) Prefix Keys\").")
(defvar helm-descbinds-Orig-describe-bindings (symbol-function 'describe-bindings))
(defvar helm-descbind--initial-full-frame helm-full-frame)
(defvar helm-descbinds--Orig-which-key-mode nil)
;; Prevent usage of both which-key and helm-descbinds, which-key is
;; starting a nasty timer which override helm-descbinds if user do not
;; type fast C-h after a prefix command e.g. C-x, ensure which-key is
;; disabled when turning on helm-descbinds-mode and reenabled (if
;; already enabled and available) when disabling helm-descbinds-mode.
(defun helm-descbinds--override-which-key (&rest _args)
"Used to override `which-key-mode' by advice."
(error "`which-key-mode' can't be used with `helm-descbinds-mode'"))
;;;###autoload
(define-minor-mode helm-descbinds-mode
"Use `helm' for `describe-bindings'.
When this mode is enabled, pressing `C-h' after a prefix key
e.g. `C-x' will pop up a helm buffer showing all the keys starting
with this prefix, one can then execute the command bound to this key,
look at the docstring or find the definition of this command."
:group 'helm-descbinds
:global t
(if helm-descbinds-mode
(progn
(advice-add 'describe-bindings :override #'helm-descbinds)
(global-unset-key (kbd "<help> C-h"))
;; Which-key mode has been started before enabling helm-descbinds-mode
(when (and (fboundp 'which-key-mode) which-key-mode
helm-descbinds-disable-which-key)
(setq helm-descbinds--Orig-which-key-mode which-key-mode)
(which-key-mode -1)
(message "Disabling `which-key-mode' which would defeat helm-descbinds"))
;; Which-key mode is not started yet, prevent starting it
;; We don't check for (fboundp 'which-key-mode) in case
;; which-key is not already installed.
(when helm-descbinds-disable-which-key
(advice-add 'which-key-mode :override #'helm-descbinds--override-which-key)))
(advice-remove 'describe-bindings #'helm-descbinds)
(global-set-key (kbd "<help> C-h") 'help-for-help)
(when (and (fboundp 'which-key-mode) helm-descbinds-disable-which-key)
(advice-remove 'which-key-mode #'helm-descbinds--override-which-key)
(which-key-mode helm-descbinds--Orig-which-key-mode))))
;;;###autoload
(defun helm-descbinds-install ()
"Use `helm-descbinds' as a replacement of `describe-bindings'."
(interactive)
(helm-descbinds-mode 1))
(make-obsolete 'helm-descbinds-install 'helm-descbinds-mode "1.08")
;;;###autoload
(defun helm-descbinds-uninstall ()
"Restore original `describe-bindings'."
(interactive)
(helm-descbinds-mode -1))
(make-obsolete 'helm-descbinds-uninstall 'helm-descbinds-mode "1.08")
(defun helm-descbinds-all-sections (buffer &optional prefix menus)
"Collect data from `describe-buffer-bindings' output.
Return a list of sections, each section beeing an alist composed of
\(KEY . COMMAND)."
(with-temp-buffer
(let ((indent-tabs-mode t))
(describe-buffer-bindings buffer prefix menus))
(goto-char (point-min))
(let ((header-p (not (= (char-after) ?\f))) ;; ?\f == ^L
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) ;; ?\f == ^L
(push (cons header (nreverse section)) sections)
(setq section nil)
(setq header-p t))
((looking-at "^[ \t]*$")) ;; ignore
(t
(let ((binding-start (save-excursion
(and (re-search-forward "\t+" nil t)
(match-end 0))))
key binding)
(when binding-start
;; For some reasons on Emacs-29 key description is
;; sometimes 2 lines long, it seems it happens with menus
;; but `describe-buffer-bindings' is always called with
;; MENUS == nil...?
(setq key (car (split-string
(buffer-substring-no-properties
(point) binding-start)
"\n" t))
key (replace-regexp-in-string "^[ \t\n]+" "" key)
key (replace-regexp-in-string "[ \t\n]+$" "" key))
(goto-char binding-start)
(setq binding (buffer-substring-no-properties
binding-start
(line-end-position)))
(unless (member binding '("self-insert-command"))
(push (cons key binding) section))))))
(forward-line))
(push (cons header (nreverse section)) sections)
(nreverse sections))))
(defun helm-descbinds-action:execute (candidate)
"An action that execute selected CANDIDATE command."
(let ((x (cdr candidate))
(helm-full-frame helm-descbind--initial-full-frame))
(cond
((equal x "Keyboard Macro")
(command-execute (kbd (car candidate))))
((stringp x)
(insert x))
((commandp x)
;; Using a timer here trigger a timer error with help-for-help
;; (and perhaps others that use a timer themselves), so use
;; directly `call-interactively'.
(call-interactively x)))))
(defun helm-descbinds-display-string-in-help (str)
"Display string STR in an help buffer."
(with-current-buffer (help-buffer)
(let ((inhibit-read-only t))
(erase-buffer)
(insert str))
(help-mode)
(display-buffer (current-buffer))))
(defun helm-descbinds-action:describe (candidate)
"An action that describe selected CANDIDATE function."
(let ((name (cdr candidate)))
(when (member name '("ignore" "ignore-event"))
(setq name 'ignore))
(pcase name
((pred (string= "Keyboard Macro"))
(describe-key (kbd (car candidate))))
((pred (string= "Prefix Command"))
(helm-descbinds-display-string-in-help
helm-descbinds-prefix-help))
((guard (and (symbolp name) (fboundp name)))
(describe-function name)))))
(defun helm-descbinds-action:find-func (candidate)
"An action that find selected CANDIDATE function."
(find-function (cdr candidate)))
(defun helm-descbinds-default-candidate-formatter (key binding)
"Default candidate formatter."
(format "%-10s\t%s"
(propertize key 'face 'helm-descbinds-key)
(propertize binding 'face 'helm-descbinds-binding)))
(defun helm-descbinds-order-section (section)
"Return the number in which SECTION should appear.
This is used to reorder all sections as sources."
(cl-loop for n = 0 then (1+ n)
for regexp in helm-descbinds-section-order
if (and (car section) (string-match regexp (car section)))
return n
finally
return n))
(defun helm-descbinds-transform-candidates (candidates)
"Transform CANDIDATES for display."
(cl-loop for (key . command) in candidates
for sym = (intern-soft command)
collect
(cons (funcall helm-descbinds-candidate-formatter key command)
(cons key (if (commandp sym) sym command)))))
(defun helm-descbinds-action-transformer (actions cand)
"Default action transformer for `helm-descbinds'.
Provide a useful behavior for prefix commands."
(if (stringp (cdr cand))
(helm-make-actions
"helm-descbinds this prefix"
(lambda (cand)
(let ((binding (car cand)))
(if (member binding '("<make-frame-visible>" "<iconify-frame>"))
(message "Key is bound to `ignore' because there is nothing to do")
(describe-bindings (kbd binding))))))
actions))
(defun helm-descbinds-sources (buffer &optional prefix menus)
"Build helm-descbinds sources for BUFFER.
If PREFIX is specified only sources for bindings starting with PREFIX
are shown. Optionally if MENUS is specified show commands that have a
starting point in menus."
(mapcar
(lambda (section)
(helm-descbinds-source (car section) (cdr section)))
(sort
(helm-descbinds-all-sections buffer prefix menus)
(lambda (a b)
(< (helm-descbinds-order-section a)
(helm-descbinds-order-section b))))))
(defclass helm-descbinds-source-class (helm-source-sync) ())
(defun helm-descbinds-source (name candidates)
"Return a helm source named NAME for displaying CANDIDATES."
(when (and name candidates)
(helm-make-source name 'helm-descbinds-source-class
:candidates candidates
:candidate-transformer #'helm-descbinds-transform-candidates
:persistent-action #'helm-descbinds-action:describe
:action-transformer #'helm-descbinds-action-transformer
:action 'helm-descbinds-actions)))
;;;###autoload
(defun helm-descbinds (&optional prefix buffer)
"A convenient helm version of `describe-bindings'.
Turning on `helm-descbinds-mode' is the recommended way to
install this command to replace `describe-bindings'.
You complete against a list of keys + command pairs presented in
a similar way as `describe-bindings' does, split into sections
defined by the types of the key bindings (minor and major modes,
global bindings, etc).
The default action executes a command as if the binding had been
entered, or narrows the commands according to a prefix key,
respectively.
The persistent action pops up a help buffer for the selected
command without quitting.
For key translation maps, the default actions are not very
useful, yet they are listed for completeness."
(interactive)
(let ((old-helm-full-frame helm-full-frame)
(helm-full-frame (and (not (minibufferp))
(memq helm-descbinds-window-style
'(same-window one-window))))
(helm-before-initialize-hook (if (and (not (minibufferp))
(eq helm-descbinds-window-style
'one-window))
(cons 'delete-other-windows
helm-before-initialize-hook)
helm-before-initialize-hook))
(enable-recursive-minibuffers t))
(setq helm-descbind--initial-full-frame old-helm-full-frame)
(helm :sources (helm-descbinds-sources
(or buffer (current-buffer)) prefix)
:buffer "*helm-descbinds*"
:resume 'noresume
:allow-nest t)))
(provide 'helm-descbinds)
;;; helm-descbinds.el ends here