diff --git a/which-key.el b/which-key.el index ff437e83ae8..95a5f76f9b6 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: ;; @@ -40,22 +40,33 @@ "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 .") ;; 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--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") + (define-minor-mode which-key-mode "Toggle which-key-mode." :global t :lighter " WK" - :require 'popwin :require 's (funcall (if which-key-mode (progn @@ -69,23 +80,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, @@ -100,16 +114,23 @@ 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/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))) @@ -123,46 +144,56 @@ 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) - 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-general-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 + (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) + formatted (which-key/format-matches + unformatted max-len-key max-len-desc))) + (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)) + (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))))) (defun which-key/setup () "Create buffer for which-key." @@ -170,16 +201,16 @@ replace and the cdr is the replacement text. " (setq which-key--setup-p t)) (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/turn-on-timer () "Activate idle timer."