From 94d5fd571c50f59938f114f52e4c43e3263b3932 Mon Sep 17 00:00:00 2001 From: justbur Date: Thu, 2 Jul 2015 18:14:04 -0400 Subject: [PATCH 1/6] Switch from popwin to display-buffer --- which-key.el | 106 ++++++++++++++++++++++++++++----------------------- 1 file changed, 59 insertions(+), 47 deletions(-) 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." From b353cd2a35d91bb5209687e1ce9e217fce34ef0a Mon Sep 17 00:00:00 2001 From: justbur Date: Thu, 2 Jul 2015 19:08:15 -0400 Subject: [PATCH 2/6] Fix text replacement alist --- which-key.el | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) 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))) From 515ed1df9607c6cbd653b9b97ee04a464db59251 Mon Sep 17 00:00:00 2001 From: justbur Date: Thu, 2 Jul 2015 19:28:36 -0400 Subject: [PATCH 3/6] Fix close timer randomly kicking in when you take too long to decide --- which-key.el | 2 ++ 1 file changed, 2 insertions(+) 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))) From ada5cfda1cb1bbc21f67b43d4182e85282102ec1 Mon Sep 17 00:00:00 2001 From: justbur Date: Thu, 2 Jul 2015 20:05:01 -0400 Subject: [PATCH 4/6] Declare `which-key--close-timer' --- which-key.el | 2 ++ 1 file changed, 2 insertions(+) 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") From 41d0d60c3d131ef58e52213b0e86ae91c5baa7f8 Mon Sep 17 00:00:00 2001 From: justbur Date: Thu, 2 Jul 2015 21:28:48 -0400 Subject: [PATCH 5/6] Add option to select display-buffer function. Only 2 are implemented at the moment. --- which-key.el | 132 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 89 insertions(+), 43 deletions(-) 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))) -(defun which-key/insert-keys (formatted-strings vertical-buffer-width) +(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) (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 :\)" From 5614be0e7d3df3bbc9870b9c81be125ebf22ad18 Mon Sep 17 00:00:00 2001 From: justbur Date: Thu, 2 Jul 2015 21:33:35 -0400 Subject: [PATCH 6/6] Remove commented funcs and messages --- which-key.el | 31 ------------------------------- 1 file changed, 31 deletions(-) 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 ()