From 5f5fc22acfbd56d998efd4b73648ccd53d694da4 Mon Sep 17 00:00:00 2001 From: justbur Date: Fri, 10 Jul 2015 10:41:30 -0400 Subject: [PATCH 1/8] Fill columns first with variable column width Allows for more compact layout --- which-key.el | 265 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 157 insertions(+), 108 deletions(-) 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)))) + (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/populate-buffer (prefix-keys formatted-keys - column-width sel-win-width) +(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) From ea115fc5dd84d1b28351661ad9b31bbc852bb662 Mon Sep 17 00:00:00 2001 From: justbur Date: Fri, 10 Jul 2015 11:56:15 -0400 Subject: [PATCH 2/8] Fix bug (layout wasn't going to 1 line) --- which-key.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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) From 0526b8b16750a09d48e5257575706db11bc96c7c Mon Sep 17 00:00:00 2001 From: justbur Date: Fri, 10 Jul 2015 12:13:50 -0400 Subject: [PATCH 3/8] Bring back error message for too small of a frame --- which-key.el | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) 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) From b399f3e02ef97cf8a07e6f89ca4cc4135f921111 Mon Sep 17 00:00:00 2001 From: Bar Magal Date: Fri, 10 Jul 2015 20:30:30 +0300 Subject: [PATCH 4/8] 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. --- which-key.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) 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)) From 5ed3e543665b1a25e47d1c72f4ad6ac497d734b7 Mon Sep 17 00:00:00 2001 From: Bar Magal Date: Fri, 10 Jul 2015 20:57:34 +0300 Subject: [PATCH 5/8] 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). --- which-key.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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)) From 1797db7255b25d7aac4449f22ca1a52a3cb0ebae Mon Sep 17 00:00:00 2001 From: justbur Date: Fri, 10 Jul 2015 14:51:45 -0400 Subject: [PATCH 6/8] Require dash --- which-key.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) 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 From 8d8e09e80972cd4001ec7efc411ecdc3b548d7b9 Mon Sep 17 00:00:00 2001 From: justbur Date: Fri, 10 Jul 2015 16:56:32 -0400 Subject: [PATCH 7/8] Re-enable the prefix option --- which-key.el | 92 +++++++++++++++++----------------------------------- 1 file changed, 30 insertions(+), 62 deletions(-) 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) From 062f98489af421c2420a69d94b6ca1ef1e16121b Mon Sep 17 00:00:00 2001 From: justbur Date: Fri, 10 Jul 2015 17:12:27 -0400 Subject: [PATCH 8/8] Reorganize code and clean-up comments a little --- which-key.el | 230 +++++++++++++++++++++++++++------------------------ 1 file changed, 123 insertions(+), 107 deletions(-) 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)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Update -(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/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))))) -(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)))) +;; 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/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