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)