bug#73568: 30.0.91; which-key error in speedbar (wrong-type-argument wholenump -13)

bug#73568: 30.0.91; which-key error in speedbar (wrong-type-argument wholenump -13)

[Morgan Willcock]

An error is signalled when which-key is activated, point is within the
speedbar frame, and a portion of a key-sequence has been typed
(e.g. C-x).

To generate an example backtrace:

  emacs -Q \
      --eval "(which-key-mode)" \
      --eval "(speedbar-get-focus)" \
      --eval "(toggle-debug-on-error)" \
      --eval "(setq unread-command-events (listify-key-sequence \"\C-x\"))"



In GNU Emacs 30.0.91 (build 2, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.16.0, Xaw3d scroll bars) of 2024-09-12 built on inspiron
Windowing system distributor 'The X.Org Foundation', version 11.0.12101007
System Description: Debian GNU/Linux 12 (bookworm)

Configured using:
 'configure --with-native-compilation=aot --with-xml2
 --with-x-toolkit=lucid'

Configured features:
CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG
LIBSELINUX LIBXML2 MODULES NATIVE_COMP NOTIFY INOTIFY PDUMPER PNG RSVG
SECCOMP SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XAW3D
XDBE XIM XINPUT2 XPM LUCID ZLIB

Important settings:
  value of $LANG: en_GB.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  server-mode: t
  global-corfu-mode: t
  corfu-mode: t
  jabber-activity-mode: t
  which-key-mode: t
  global-devil-mode: t
  devil-mode: t
  erc-ring-mode: t
  erc-netsplit-mode: t
  erc-menu-mode: t
  erc-list-mode: t
  erc-imenu-mode: t
  erc-button-mode: t
  erc-fill-mode: t
  erc-stamp-mode: t
  erc-irccontrols-mode: t
  erc-move-to-prompt-mode: t
  erc-readonly-mode: t
  erc-scrolltobottom-mode: t
  erc-spelling-mode: t
  erc-track-mode: t
  erc-match-mode: t
  erc-autojoin-mode: t
  erc-networks-mode: t
  savehist-mode: t
  minibuffer-electric-default-mode: t
  minibuffer-depth-indicate-mode: t
  ido-everywhere: t
  recentf-mode: t
  global-display-fill-column-indicator-mode: t
  global-hl-line-mode: t
  display-time-mode: t
  flyspell-mode: t
  editorconfig-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  minibuffer-regexp-mode: t
  column-number-mode: t
  line-number-mode: t
  transient-mark-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t

Load-path shadows:
/home/mwillcock/.emacs.d/custom/flymake-ansible-lint.el/flymake-ansible-lint hides /home/mwillcock/.emacs.d/custom/flymake-ansible-lint
/home/mwillcock/.emacs.d/custom/powershell.el/powershell hides /home/mwillcock/.emacs.d/custom/powershell
/home/mwillcock/.emacs.d/elpa/which-key-3.6.1/which-key hides /usr/local/share/emacs/30.0.91/lisp/which-key
/home/mwillcock/.emacs.d/elpa/modus-themes-4.5.0/theme-loaddefs hides /usr/local/share/emacs/30.0.91/lisp/theme-loaddefs

Features:
(shadow sort ecomplete mail-extr help-fns radix-tree emacsbug gnus-async
gnus-ml disp-table gnus-topic nndraft nnmh utf-7 cursor-sensor epa-file
network-stream nsm nnfolder nnnil gnus-agent gnus-srvr gnus-score
score-mode nnvirtual gnus-cache gnus-demon nntp server cal-iso
autorevert face-remap init corfu sly sly-completion sly-buttons
sly-messages sly-common apropos arc-mode archive-mode hyperspec
powershell php-mode mode-local consult-imenu consult php-face php
php-project jabber jabber-ourversion hippie-exp hexrgb fsm sgml-mode
facemenu srv dns starttls tls goto-addr yaml-mode markdown-mode lua-mode
advice edmacro kmacro kixtart-docstrings kixtart-mode tempo etags
fileloop org-msg let-alist color ox-odt rng-loc rng-uri rng-parse
rng-match rng-dt rng-util rng-pttrn nxml-parse nxml-ns nxml-enc xmltok
nxml-util ox-latex ox-icalendar ox-html table ox-ascii ox-publish ox
org-attach htmlize gnus-msg gnus-icalendar icalendar gnus-dired
gnus-cite which-key devil delight comp comp-cstr ags-mode speedbar
ezimage dframe shadowfile eglot jsonrpc xref flymake diff ert ewoc debug
backtrace warnings python project cc-mode cc-fonts cc-guess cc-menus
cc-cmds cc-styles cc-align cc-engine cc-vars cc-defs erc-sasl
erc-sasl-ecdsa-nist256p-challenge erc-sasl-scram-sha-512
erc-sasl-scram-sha-256 erc-sasl-scram-sha-1 erc-sasl-external
erc-sasl-plain sasl-scram-sha256 sasl-scram-rfc sasl-scram-sha-1 rfc2104
hex-util sasl sasl-anonymous sasl-login sasl-plain erc-ring erc-netsplit
erc-menu erc-list erc-imenu imenu erc-pcomplete erc-button erc-fill
erc-stamp erc-goodies erc-spelling erc-track erc-match erc-join erc
erc-backend erc-networks erc-common erc-compat compat erc-loaddefs ediff
ediff-merg ediff-mult ediff-wind ediff-diff ediff-help ediff-init
ediff-util vc-git diff-mode track-changes vc-dispatcher org-indent
oc-basic cl-extra ol-eww eww url-queue mm-url ol-rmail ol-mhe ol-irc
ol-info ol-gnus nnselect gnus-art mm-uu mml2015 gnus-sum ol-docview
ol-bibtex bibtex ol-bbdb ol-w3m ol-doi org-link-doi appt diary-lib
diary-loaddefs org-capture ob-shell ob-plantuml ob-dot org-goto
org-clock comp-run comp-common org-duration org-agenda org-element
org-persist org-id org-element-ast inline avl-tree generator org-refile
org ob ob-tangle ob-ref ob-lob ob-table ob-exp org-macro org-src
sh-script smie treesit executable ob-comint org-pcomplete org-list
org-footnote org-faces org-entities noutline outline ob-emacs-lisp
ob-core ob-eval org-version org-cycle org-table ol org-fold
org-fold-core org-keys oc org-loaddefs thingatpt org-compat org-macs
autoinsert compile bookmark savehist crm minibuf-eldef mb-depth ido
tramp-cache time-stamp tramp-sh tramp rx trampver tramp-integration
files-x tramp-message tramp-compat xdg format-spec tramp-loaddefs
recentf tree-widget shell pcomplete comint ansi-osc ansi-color ring
easy-mmode display-fill-column-indicator hl-line time gnus-group
gnus-undo gnus-start gnus-dbus dbus gnus-cloud nnimap nnmail mail-source
utf7 nnoo parse-time iso8601 gnus-spec gnus-int gnus-range gnus-win gnus
nnheader range cus-edit pp cus-load wid-edit dictionary
external-completion dictionary-connection flyspell ispell shr pixel-fill
kinsoku url-file svg xml dom modus-vivendi-theme modus-themes
editorconfig editorconfig-core editorconfig-core-handle
editorconfig-fnmatch mm-view mml-smime smime gnutls dig smtpmail message
sendmail yank-media puny rfc822 mml mml-sec epa derived epg rfc6068
gnus-util text-property-search time-date mm-decode mm-bodies mm-encode
mail-parse rfc2231 rfc2047 rfc2045 mm-util ietf-drums mail-prsvr
mailabbrev mail-utils gmm-utils mailheader epg-config help-mode doc-view
filenotify jka-compr image-mode exif dired dired-loaddefs dabbrev
find-func cal-menu calendar cal-loaddefs desktop frameset pcase
cape-autoloads consult-autoloads corfu-autoloads delight-autoloads
do-at-point-autoloads fsm-autoloads htmlize-autoloads
indent-bars-autoloads lua-mode-autoloads markdown-mode-autoloads
modus-themes-autoloads package-lint-autoloads php-mode-autoloads
rainbow-mode-autoloads renpy-mode-autoloads sly-autoloads
totp-auth-autoloads base32-autoloads info vertico-autoloads
wgrep-autoloads which-key-autoloads yaml-mode-autoloads package
browse-url url url-proxy url-privacy url-expand url-methods url-history
url-cookie generate-lisp-file url-domsuf url-util mailcap url-handlers
url-parse auth-source cl-seq eieio eieio-core cl-macs icons
password-cache json subr-x map byte-opt gv bytecomp byte-compile
url-vars cl-loaddefs cl-lib rmc iso-transl tooltip cconv eldoc paren
electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd touch-screen tool-bar dnd fontset
image regexp-opt fringe tabulated-list replace newcomment text-mode
lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch
easymenu timer select scroll-bar mouse jit-lock font-lock syntax
font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic
indonesian philippine cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs
theme-loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify
dynamic-setting system-font-setting font-render-setting cairo x-toolkit
xinput2 x multi-tty move-toolbar make-network-process native-compile
emacs)

Memory information:
((conses 16 1734054 216227) (symbols 48 52811 10)
 (strings 32 265247 6499) (string-bytes 1 7481013) (vectors 16 150170)
 (vector-slots 8 2584682 116606) (floats 8 799 832)
 (intervals 56 127804 159) (buffers 984 29))

bug#73568: 30.0.91; which-key error in speedbar (wrong-type-argument wholenump -13)

[Stefan Kangas]

Morgan Willcock <morgan@ice9.digital> writes:

> An error is signalled when which-key is activated, point is within the
> speedbar frame, and a portion of a key-sequence has been typed
> (e.g. C-x).
>
> To generate an example backtrace:
>
>   emacs -Q \
>       --eval "(which-key-mode)" \
>       --eval "(speedbar-get-focus)" \
>       --eval "(toggle-debug-on-error)" \
>       --eval "(setq unread-command-events (listify-key-sequence \"\C-x\"))"

Here's the error I get:

Debugger entered--Lisp error: (wrong-type-argument wholenump -14)
  make-string(-14 32)

The problem occurs is in `which-key--pad-column': the speedbar frame is
only 14 characters wide, and so can't fit longer strings than that.

I actually see two bugs here:

1. Create a regular Emacs frame of width 14, enable `which-key-mode' and
   press some key, e.g. C-h.  You now get a similar backtrace.  Probably
   `which-key' should simply be smarter in this case, for example by
   truncating instead of padding.

2. With a dframe, as in speedbar, I guess `which-key' should try to
   display it's help window in the original frame?

I'm copying in Justin Burkett.

bug#73568: 30.0.91; which-key error in speedbar (wrong-type-argument wholenump -13)

[Justin Burkett]

[-- Attachment #1: Type: text/plain, Size: 1548 bytes --]

Thanks. Can you try the attached patch for the first problem?

I'm not sure what the best approach is with speedbar. I'm inclined to
disable which-key for that case, but maybe showing which-key in the
original frame is better?

On Mon, Sep 30, 2024 at 5:53 PM Stefan Kangas <stefankangas@gmail.com> wrote:
>
> Morgan Willcock <morgan@ice9.digital> writes:
>
> > An error is signalled when which-key is activated, point is within the
> > speedbar frame, and a portion of a key-sequence has been typed
> > (e.g. C-x).
> >
> > To generate an example backtrace:
> >
> >   emacs -Q \
> >       --eval "(which-key-mode)" \
> >       --eval "(speedbar-get-focus)" \
> >       --eval "(toggle-debug-on-error)" \
> >       --eval "(setq unread-command-events (listify-key-sequence \"\C-x\"))"
>
> Here's the error I get:
>
> Debugger entered--Lisp error: (wrong-type-argument wholenump -14)
>   make-string(-14 32)
>
> The problem occurs is in `which-key--pad-column': the speedbar frame is
> only 14 characters wide, and so can't fit longer strings than that.
>
> I actually see two bugs here:
>
> 1. Create a regular Emacs frame of width 14, enable `which-key-mode' and
>    press some key, e.g. C-h.  You now get a similar backtrace.  Probably
>    `which-key' should simply be smarter in this case, for example by
>    truncating instead of padding.
>
> 2. With a dframe, as in speedbar, I guess `which-key' should try to
>    display it's help window in the original frame?
>
> I'm copying in Justin Burkett.

[-- Attachment #2: 0001-Fix-which-key-layout-error-when-available-width-is-s.patch --]
[-- Type: application/octet-stream, Size: 4332 bytes --]

From a8015d0c3f5cc5c1d0b1b45f4b7c096dbfc92664 Mon Sep 17 00:00:00 2001
From: Justin Burkett <justin@burkett.cc>
Date: Tue, 1 Oct 2024 21:52:07 -0400
Subject: [PATCH] Fix which-key layout error when available width is small

* lisp/which-key.el (which-key--col-widths): Add more efficient function
for calculating column widths
(which-key--pad-column): Handle case where available width for which-key
buffer is smaller than the width of a single column.
---
 lisp/which-key.el | 71 ++++++++++++++++++++++++++++++++---------------
 1 file changed, 48 insertions(+), 23 deletions(-)

diff --git a/lisp/which-key.el b/lisp/which-key.el
index 232145f7fb5..6fd61462abe 100644
--- a/lisp/which-key.el
+++ b/lisp/which-key.el
@@ -39,6 +39,7 @@
 (require 'cl-lib)
 (require 'button)
 (require 'regexp-opt)
+(require 'seq)
 
 ;; For compiler
 (defvar evil-operator-shortcut-map)
@@ -2012,33 +2013,57 @@ which-key--join-columns
          (rows (apply #'cl-mapcar #'list padded)))
     (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n")))
 
-(defsubst which-key--max-len (keys index &optional initial-value)
-  "Find the max length of the INDEX element in each of KEYS."
-  (cl-reduce
-   (lambda (x y) (max x (which-key--string-width (nth index y))))
-   keys :initial-value (if initial-value initial-value 0)))
+(defun which-key--col-widths (keys)
+  "Find the max length of each column in KEYS.
+KEYS is assumed to be a list of lists of strings, where the sublists all
+have the same number of strings."
+  (let* ((n (length (car keys))))
+    (seq-reduce
+     (lambda (x y)
+       (seq-map-indexed
+        (lambda (e i)
+          (max (nth i x) (which-key--string-width e)))
+        y))
+     keys
+     (make-list n 0))))
 
 (defun which-key--pad-column (col-keys avl-width)
-  "Pad cells of COL-KEYS to AVL-WIDTH.
+  "Pad COL-KEYS cells to same width respecting AVL-WIDTH.
 Take a column of (key separator description) COL-KEYS,
 calculate the max width in the column and pad all cells out to
-that width."
-  (let* ((col-key-width  (+ which-key-add-column-padding
-                            (which-key--max-len col-keys 0)))
-         (col-sep-width  (which-key--max-len col-keys 1))
-         (avl-width      (- avl-width col-key-width col-sep-width))
-         (col-desc-width (min avl-width
-                              (which-key--max-len
-                               col-keys 2
-                               which-key-min-column-description-width)))
-         (col-width      (+ col-key-width col-sep-width col-desc-width))
-         (col-format     (concat "%" (int-to-string col-key-width) "s%s%s")))
-    (cons col-width
-          (mapcar (pcase-lambda (`(,key ,sep ,desc ,_doc))
-                    (concat
-                     (format col-format key sep desc)
-                     (make-string (- col-desc-width (string-width desc)) ?\s)))
-                  col-keys))))
+that width.
+
+If AVL-WIDTH is too small to contain the column, truncate the last
+element of COL-KEYS instead."
+  (let* ((col-widths (which-key--col-widths col-keys))
+         (key-col-width (+ which-key-add-column-padding
+                           (nth 0 col-widths)))
+         (sep-col-width (nth 1 col-widths))
+         (rem-avl-width (- avl-width key-col-width sep-col-width))
+         (desc-col-width (nth 2 col-widths))
+         (total-width (+ key-col-width sep-col-width desc-col-width)))
+    (cond
+     ((> which-key-min-column-description-width desc-col-width rem-avl-width)
+      ;; we can't fit the column
+      (cons 0 (make-list (length col-keys) "")))
+     ((> desc-col-width rem-avl-width)
+      ;; truncate the last column
+      (cons avl-width
+            (mapcar
+             (pcase-lambda (`(,key ,sep ,desc ,_doc))
+               (string-limit
+                (format (format "%%%ds%%s%%s" key-col-width) key sep desc)
+                avl-width))
+             col-keys)))
+     (t
+      ;; pad the last column
+      (cons total-width
+            (mapcar
+             (pcase-lambda (`(,key ,sep ,desc ,_doc))
+               (string-pad
+                (format (format "%%%ds%%s%%s" key-col-width) key sep desc)
+                total-width))
+             col-keys))))))
 
 (defun which-key--partition-list (n list)
   "Partition LIST into N-sized sublists."
-- 
2.46.2

bug#73568: 30.0.91; which-key error in speedbar (wrong-type-argument wholenump -13)

[Eli Zaretskii]

> Cc: 73568@debbugs.gnu.org, Morgan Willcock <morgan@ice9.digital>
> From: Justin Burkett <justin@burkett.cc>
> Date: Tue, 1 Oct 2024 22:01:12 -0400
> 
> Thanks. Can you try the attached patch for the first problem?

Could you use string-pixel-width there instead of
which-key--col-widths?  If not, why not?

> I'm not sure what the best approach is with speedbar. I'm inclined to
> disable which-key for that case, but maybe showing which-key in the
> original frame is better?

I vote for the latter.

Thanks.