Skip to content

Commit ab3ff47

Browse files
justburjustbur
committed
Merge bmag changes
See PR #1
2 parents da0f7e1 + 963944c commit ab3ff47

File tree

1 file changed

+180
-151
lines changed

1 file changed

+180
-151
lines changed

‎which-key.el‎

Lines changed: 180 additions & 151 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,9 @@ cells for replacing any text, keys and descriptions.")
4141
(defvar which-key-buffer-position 'bottom
4242
"Position of which-key buffer.")
4343
(defvar which-key-vertical-buffer-width 60
44-
"Width of which-key buffer .")
44+
"Width of which-key buffer.")
45+
(defvar which-key-horizontal-buffer-height 20
46+
"Height of which-key buffer.")
4547
(defvar which-key-display-method 'minibuffer
4648
"Controls the method used to display the keys. The default is
4749
minibuffer, but other possibilities are 'popwin and
@@ -72,16 +74,15 @@ currently disabled.")
7274
"Toggle which-key-mode."
7375
:global t
7476
:lighter " WK"
75-
(if which-key-mode
76-
(progn
77-
(unless which-key--setup-p (which-key/setup))
78-
(add-hook 'focus-out-hook 'which-key/stop-open-timer)
79-
(add-hook 'focus-in-hook 'which-key/start-open-timer)
80-
(which-key/make-display-method-aliases which-key-display-method)
81-
(which-key/start-open-timer))
82-
(remove-hook 'focus-out-hook 'which-key/stop-open-timer)
83-
(remove-hook 'focus-in-hook 'which-key/start-open-timer)
84-
(which-key/stop-open-timer)))
77+
(if which-key-mode
78+
(progn
79+
(unless which-key--setup-p (which-key/setup))
80+
(add-hook 'focus-out-hook 'which-key/stop-open-timer)
81+
(add-hook 'focus-in-hook 'which-key/start-open-timer)
82+
(which-key/start-open-timer))
83+
(remove-hook 'focus-out-hook 'which-key/stop-open-timer)
84+
(remove-hook 'focus-in-hook 'which-key/start-open-timer)
85+
(which-key/stop-open-timer)))
8586

8687
(defun which-key/setup ()
8788
"Create buffer for which-key."
@@ -93,75 +94,139 @@ currently disabled.")
9394
(setq-local cursor-in-non-selected-windows nil))
9495
(setq which-key--setup-p t))
9596

96-
;; Helper functions
97+
;; Timers
9798

98-
(defsubst which-key/truncate-description (desc)
99-
"Truncate DESC description to `which-key-max-description-length'."
100-
(if (> (length desc) which-key-max-description-length)
101-
(concat (substring desc 0 which-key-max-description-length) "..")
102-
desc))
99+
(defun which-key/start-open-timer ()
100+
"Activate idle timer."
101+
(which-key/stop-open-timer) ; start over
102+
(setq which-key--open-timer
103+
(run-with-idle-timer which-key-idle-delay t 'which-key/update)))
103104

104-
(defun which-key/available-lines-per-page ()
105-
"Only works for minibuffer right now."
106-
(when (eq which-key-display-method 'minibuffer)
107-
(if (floatp max-mini-window-height)
108-
(floor (* (frame-text-lines)
109-
max-mini-window-height))
110-
max-mini-window-height)))
105+
(defun which-key/stop-open-timer ()
106+
"Deactivate idle timer."
107+
(when which-key--open-timer (cancel-timer which-key--open-timer)))
111108

112-
(defun which-key/replace-strings-from-alist (replacements)
113-
"Find and replace text in buffer according to REPLACEMENTS,
114-
which is an alist where the car of each element is the text to
115-
replace and the cdr is the replacement text."
116-
(dolist (rep replacements)
117-
(save-excursion
118-
(goto-char (point-min))
119-
(while (or (search-forward (car rep) nil t))
120-
(replace-match (cdr rep) t t)))))
109+
(defun which-key/start-close-timer ()
110+
"Activate idle timer."
111+
(which-key/stop-close-timer) ; start over
112+
(setq which-key--close-timer
113+
(run-at-time which-key-close-buffer-idle-delay
114+
nil 'which-key/hide-buffer)))
115+
116+
(defun which-key/stop-close-timer ()
117+
"Deactivate idle timer."
118+
(when which-key--close-timer (cancel-timer which-key--close-timer)))
121119

122-
;; in case I decide to add padding
123-
;; (defsubst which-key/buffer-height (line-breaks) line-breaks)
120+
;; Update
121+
122+
(defun which-key/update ()
123+
"Fill which-key--buffer with key descriptions and reformat.
124+
Finally, show the buffer."
125+
(let ((key (this-single-command-keys)))
126+
(if (> (length key) 0)
127+
(progn
128+
(which-key/stop-close-timer)
129+
(which-key/hide-buffer)
130+
(let* ((buf (current-buffer))
131+
;; (bottom-or-top (member which-key-buffer-position '(top bottom)))
132+
;; get formatted key bindings
133+
(fmt-width-cons (which-key/get-formatted-key-bindings buf key))
134+
(formatted-keys (car fmt-width-cons))
135+
(column-width (cdr fmt-width-cons))
136+
(buffer-width (which-key/buffer-width column-width (window-width)))
137+
;; populate target buffer
138+
(n-lines (which-key/populate-buffer formatted-keys column-width buffer-width)))
139+
;; show buffer
140+
(when (which-key/show-buffer n-lines buffer-width)
141+
(which-key/start-close-timer))))
142+
;; command finished maybe close the window
143+
(which-key/hide-buffer))))
144+
145+
;; Show/hide guide buffer
146+
147+
;; Should this be used instead?
148+
;; (defun which-key/hide-buffer-display-buffer ()
149+
;; (when (window-live-p which-key--window)
150+
;; (delete-window which-key--window)))
151+
152+
(defun which-key/hide-buffer ()
153+
(when (buffer-live-p which-key--buffer)
154+
(delete-windows-on which-key--buffer)))
155+
156+
(defun which-key/show-buffer (height width)
157+
"Show guide window.
158+
Return nil if no window is shown, or if there is no need to start the
159+
closing timer."
160+
(cl-case which-key-display-method
161+
(minibuffer (which-key/show-buffer-minibuffer height width))
162+
(side-window (which-key/show-buffer-side-window height width))))
163+
164+
(defun which-key/show-buffer-minibuffer (height width)
165+
nil)
166+
167+
(defun which-key/show-buffer-side-window (height width)
168+
(let* ((side which-key-buffer-position)
169+
(alist (delq nil (list (when side (cons 'side side))
170+
(when height (cons 'window-height height))
171+
(when width (cons 'window-width width))))))
172+
(display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist))))
173+
174+
;; Keep for popwin maybe (Used to work)
175+
;; (defun which-key/show-buffer-popwin (height width)
176+
;; "Using popwin popup buffer with dimensions HEIGHT and WIDTH."
177+
;; (popwin:popup-buffer which-key-buffer-name
178+
;; :height height
179+
;; :width width
180+
;; :noselect t
181+
;; :position which-key-buffer-position))
182+
183+
;; (defun which-key/hide-buffer-popwin ()
184+
;; "Hide popwin buffer."
185+
;; (when (eq popwin:popup-buffer (get-buffer which-key--buffer))
186+
;; (popwin:close-popup-window)))
187+
188+
;; Size functions
124189

125190
(defun which-key/buffer-width (column-width sel-window-width)
126-
(cond ((eq which-key-display-method 'minibuffer)
127-
(frame-text-cols))
128-
((and (eq which-key-buffer-display-function 'display-buffer-in-side-window)
129-
(member which-key-buffer-position '(left right)))
130-
(min which-key-vertical-buffer-width column-width))
131-
((eq which-key-buffer-display-function 'display-buffer-in-side-window)
132-
(frame-text-width))
133-
;; ((eq which-key-buffer-display-function 'display-buffer-below-selected)
134-
;; sel-window-width)
135-
(t nil)))
191+
(cl-case which-key-display-method
192+
(minibuffer (which-key/buffer-width-minibuffer column-width sel-window-width))
193+
(side-window (which-key/buffer-width-side-window column-width sel-window-width))))
194+
195+
(defun which-key/buffer-width-minibuffer (column-width sel-window-width)
196+
(frame-text-cols))
197+
198+
(defun which-key/buffer-width-side-window (column-width sel-window-width)
199+
(if (member which-key-buffer-position '(left right))
200+
(min which-key-vertical-buffer-width column-width)
201+
(frame-width)))
202+
203+
;; (defun which-key/available-lines ()
204+
;; "Only works for minibuffer right now."
205+
;; (when (eq which-key-display-method 'minibuffer)
206+
;; (if (floatp max-mini-window-height)
207+
;; (floor (* (frame-text-lines)
208+
;; max-mini-window-height))
209+
;; max-mini-window-height)))
210+
211+
(defun which-key/available-lines ()
212+
(cl-case which-key-display-method
213+
(minibuffer (which-key/available-lines-minibuffer))
214+
(side-window (which-key/available-lines-side-window))))
215+
216+
(defun which-key/available-lines-minibuffer ()
217+
"Only works for minibuffer right now."
218+
(if (floatp max-mini-window-height)
219+
(floor (* (frame-text-lines)
220+
max-mini-window-height))
221+
max-mini-window-height))
136222

137-
(defun which-key/format-matches (unformatted max-len-key max-len-desc)
138-
"Turn each key-desc-cons in UNFORMATTED into formatted
139-
strings (including text properties), and pad with spaces so that
140-
all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the
141-
longest key and description in the buffer, respectively."
142-
(mapcar
143-
(lambda (key-desc-cons)
144-
(let* ((key (car key-desc-cons))
145-
(desc (cdr key-desc-cons))
146-
(group (string-match-p "^group:" desc))
147-
(desc (if group (substring desc 6) desc))
148-
(prefix (string-match-p "^Prefix" desc))
149-
(desc (if (or prefix group) (concat "+" desc) desc))
150-
(desc-face (if (or prefix group)
151-
'font-lock-keyword-face 'font-lock-function-name-face))
152-
;; (sign (if (or prefix group) "▶" "→"))
153-
(sign "→")
154-
(desc (which-key/truncate-description desc))
155-
;; pad keys to max-len-key
156-
(padded-key (s-pad-left max-len-key " " key))
157-
(padded-desc (s-pad-right max-len-desc " " desc)))
158-
(format (concat (propertize "%s" 'face 'font-lock-constant-face) " "
159-
(propertize sign 'face 'font-lock-comment-face) " "
160-
(propertize "%s" 'face desc-face) " ")
161-
padded-key padded-desc)))
162-
unformatted))
223+
(defun which-key/available-lines-side-window ()
224+
(if (member which-key-buffer-position '(left right))
225+
(frame-height)
226+
;; FIXME: change to something like (min which-*-height (calculate-max-height))
227+
which-key-horizontal-buffer-height))
163228

164-
;; "Core" functions
229+
;; Buffer contents functions
165230

166231
(defun which-key/get-formatted-key-bindings (buffer key)
167232
(let ((max-len-key 0) (max-len-desc 0)
@@ -205,7 +270,7 @@ longest key and description in the buffer, respectively."
205270
(let* ((width (if buffer-width buffer-width (frame-text-width)))
206271
(n-keys (length formatted-keys))
207272
(n-columns (/ width column-width)) ;; integer division
208-
(avl-lines/page (which-key/available-lines-per-page))
273+
(avl-lines/page (which-key/available-lines))
209274
(n-keys/page (when avl-lines/page (* n-columns avl-lines/page)))
210275
(n-pages (if n-keys/page
211276
(ceiling (/ (float n-keys) n-keys/page)) 1))
@@ -219,88 +284,52 @@ longest key and description in the buffer, respectively."
219284
(setq pages (reverse pages))
220285
(if (eq which-key-display-method 'minibuffer)
221286
(let (message-log-max) (message "%s" (car pages)))
222-
(insert (car pages))))
287+
(with-current-buffer which-key--buffer
288+
(insert (car pages)))))
223289
n-lines))
224290

225-
(defun which-key/update ()
226-
"Fill which-key--buffer with key descriptions and reformat.
227-
Finally, show the buffer."
228-
(let ((key (this-single-command-keys)))
229-
(if (> (length key) 0)
230-
(progn
231-
(when which-key--close-timer (cancel-timer which-key--close-timer))
232-
(which-key/hide-buffer)
233-
(let* ((buf (current-buffer))
234-
(bottom-or-top (member which-key-buffer-position '(top bottom)))
235-
;; get formatted key bindings
236-
(fmt-width-cons (which-key/get-formatted-key-bindings buf key))
237-
(formatted-keys (car fmt-width-cons))
238-
(column-width (cdr fmt-width-cons))
239-
(buffer-width (which-key/buffer-width column-width (window-width)))
240-
n-lines)
241-
;; populate target buffer
242-
(setq n-lines (which-key/populate-buffer
243-
formatted-keys column-width buffer-width))
244-
;; show buffer
245-
(unless (eq which-key-display-method 'minibuffer)
246-
(setq which-key--window (which-key/show-buffer n-lines buffer-width)
247-
which-key--close-timer (run-at-time
248-
which-key-close-buffer-idle-delay
249-
nil 'which-key/hide-buffer)))))
250-
;; command finished maybe close the window
251-
(which-key/hide-buffer))))
252-
253-
;; Timers
291+
(defun which-key/replace-strings-from-alist (replacements)
292+
"Find and replace text in buffer according to REPLACEMENTS,
293+
which is an alist where the car of each element is the text to
294+
replace and the cdr is the replacement text."
295+
(dolist (rep replacements)
296+
(save-excursion
297+
(goto-char (point-min))
298+
(while (or (search-forward (car rep) nil t))
299+
(replace-match (cdr rep) t t)))))
254300

255-
(defun which-key/start-open-timer ()
256-
"Activate idle timer."
257-
(when which-key--open-timer (cancel-timer which-key--open-timer)); start over
258-
(setq which-key--open-timer
259-
(run-with-idle-timer which-key-idle-delay t 'which-key/update)))
301+
(defun which-key/format-matches (unformatted max-len-key max-len-desc)
302+
"Turn each key-desc-cons in UNFORMATTED into formatted
303+
strings (including text properties), and pad with spaces so that
304+
all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the
305+
longest key and description in the buffer, respectively."
306+
(mapcar
307+
(lambda (key-desc-cons)
308+
(let* ((key (car key-desc-cons))
309+
(desc (cdr key-desc-cons))
310+
(group (string-match-p "^group:" desc))
311+
(desc (if group (substring desc 6) desc))
312+
(prefix (string-match-p "^Prefix" desc))
313+
(desc (if (or prefix group) (concat "+" desc) desc))
314+
(desc-face (if (or prefix group)
315+
'font-lock-keyword-face 'font-lock-function-name-face))
316+
;; (sign (if (or prefix group) "▶" "→"))
317+
(sign "→")
318+
(desc (which-key/truncate-description desc))
319+
;; pad keys to max-len-key
320+
(padded-key (s-pad-left max-len-key " " key))
321+
(padded-desc (s-pad-right max-len-desc " " desc)))
322+
(format (concat (propertize "%s" 'face 'font-lock-constant-face) " "
323+
(propertize sign 'face 'font-lock-comment-face) " "
324+
(propertize "%s" 'face desc-face) " ")
325+
padded-key padded-desc)))
326+
unformatted))
260327

261-
(defun which-key/stop-open-timer ()
262-
"Deactivate idle timer."
263-
(cancel-timer which-key--open-timer))
264-
265-
;; placeholder for page flipping
266-
;; (defun which-key/start-next-page-timer ())
267-
268-
;; Display functions
269-
270-
(defun which-key/show-buffer-display-buffer (height width)
271-
(let ((side which-key-buffer-position) alist)
272-
(setq alist (list (when side (cons 'side side))
273-
(when height (cons 'window-height height))
274-
(when width (cons 'window-width width))))
275-
(display-buffer "*which-key*" (cons which-key-buffer-display-function alist))))
276-
277-
(defun which-key/hide-buffer-display-buffer ()
278-
(when (window-live-p which-key--window)
279-
(delete-window which-key--window)))
280-
281-
(defun which-key/show-buffer-popwin (height width)
282-
"Using popwin popup buffer with dimensions HEIGHT and WIDTH."
283-
(popwin:popup-buffer which-key-buffer-name
284-
:height height
285-
:width width
286-
:noselect t
287-
:position which-key-buffer-position))
288-
289-
(defun which-key/hide-buffer-popwin ()
290-
"Hide popwin buffer."
291-
(when (eq popwin:popup-buffer (get-buffer which-key--buffer))
292-
(popwin:close-popup-window)))
293-
294-
(defun which-key/make-display-method-aliases (method)
295-
(cond
296-
((eq method 'minibuffer)
297-
(defun which-key/hide-buffer ()))
298-
((member method '(popwin display-buffer))
299-
(defalias 'which-key/show-buffer
300-
(intern (concat "which-key/show-buffer-" (symbol-name method))))
301-
(defalias 'which-key/hide-buffer
302-
(intern (concat "which-key/hide-buffer-" (symbol-name method)))))
303-
(t (error "error: Invalid choice for which-key-display-method"))))
328+
(defsubst which-key/truncate-description (desc)
329+
"Truncate DESC description to `which-key-max-description-length'."
330+
(if (> (length desc) which-key-max-description-length)
331+
(concat (substring desc 0 which-key-max-description-length) "..")
332+
desc))
304333

305334
(provide 'which-key)
306335

0 commit comments

Comments
 (0)