Package: emacs;
Reported by: JD Smith <jdtsmith <at> gmail.com>
Date: Thu, 4 Jan 2024 03:10:02 UTC
Severity: wishlist
Tags: patch
View this message in rfc822 format
From: JD Smith <jdtsmith <at> gmail.com> To: 68236 <at> debbugs.gnu.org Subject: bug#68236: [PATCH] help.el: allow help-quick to use local commands/quick-sections Date: Wed, 3 Jan 2024 22:08:56 -0500
Someone came up with the great idea of using help.el’s `help-quick' command for a personal “scratch pad” of useful/hard-to-remember bindings, and then to bind `help-quick-sections' locally in various modes. Unfortunately, `help-quick' first sets the buffer to *Quick Help* and then builds its list of command bindings and descriptions. This means that only the default value of `help-quick-sections’ will ever be consulted, and no local key bindings can be expressed.
The fix is simple; build the list of quick help information first in the current buffer (from which C-h C-q is called) and then displaying it in the *Quick Help* buffer. With this, people can use quick help and its handy binding to prompt with their own personal hard-to-remember key bindings/command info. What’s cool is that help-quick omits “empty” sections, so you could even add a variety of sections, and they will appear if and only if bindings are actually available in the buffer where quick help is invoked.
+++
diff -u lisp/help.el lisp/help_fix_quick.el
--- lisp/help.el 2024-01-03 21:54:46
+++ lisp/help_fix_quick.el 2024-01-03 21:52:46
@@ -173,78 +173,79 @@
(defun help-quick ()
"Display a quick-help buffer."
(interactive)
- (with-current-buffer (get-buffer-create "*Quick Help*")
- (let ((inhibit-read-only t) (padding 2) blocks)
+ (let ((buf (get-buffer-create "*Quick Help*"))
+ (inhibit-read-only t) (padding 2) blocks)
- ;; Go through every section and prepare a text-rectangle to be
- ;; inserted later.
- (dolist (section help-quick-sections)
- (let ((max-key-len 0) (max-cmd-len 0) keys)
- (dolist (ent (reverse (cdr section)))
- (catch 'skip
- (let* ((bind (where-is-internal (car ent) nil t))
- (key (if bind
- (propertize
- (key-description bind)
- 'face 'help-key-binding)
- (throw 'skip nil))))
- (setq max-cmd-len (max (length (cdr ent)) max-cmd-len)
- max-key-len (max (length key) max-key-len))
- (push (list key (cdr ent) (car ent)) keys))))
- (when keys
- (let ((fmt (format "%%-%ds %%-%ds%s" max-key-len max-cmd-len
- (make-string padding ?\s)))
- (width (+ max-key-len 1 max-cmd-len padding)))
- (push `(,width
- ,(propertize
- (concat
- (car section)
- (make-string (- width (length (car section))) ?\s))
- 'face 'bold)
- ,@(mapcar (lambda (ent)
- (format fmt
- (propertize
- (car ent)
- 'quick-help-cmd
- (caddr ent))
- (cadr ent)))
- keys))
- blocks)))))
+ ;; Go through every section and prepare a text-rectangle to be
+ ;; inserted later.
+ (dolist (section help-quick-sections)
+ (let ((max-key-len 0) (max-cmd-len 0) keys)
+ (dolist (ent (reverse (cdr section)))
+ (catch 'skip
+ (let* ((bind (where-is-internal (car ent) nil t))
+ (key (if bind
+ (propertize
+ (key-description bind)
+ 'face 'help-key-binding)
+ (throw 'skip nil))))
+ (setq max-cmd-len (max (length (cdr ent)) max-cmd-len)
+ max-key-len (max (length key) max-key-len))
+ (push (list key (cdr ent) (car ent)) keys))))
+ (when keys
+ (let ((fmt (format "%%-%ds %%-%ds%s" max-key-len max-cmd-len
+ (make-string padding ?\s)))
+ (width (+ max-key-len 1 max-cmd-len padding)))
+ (push `(,width
+ ,(propertize
+ (concat
+ (car section)
+ (make-string (- width (length (car section))) ?\s))
+ 'face 'bold)
+ ,@(mapcar (lambda (ent)
+ (format fmt
+ (propertize
+ (car ent)
+ 'quick-help-cmd
+ (caddr ent))
+ (cadr ent)))
+ keys))
+ blocks)))))
- ;; Insert each rectangle in order until they don't fit into the
- ;; frame any more, in which case the next sections are inserted
- ;; in a new "line".
+ ;; Insert each rectangle in order until they don't fit into the
+ ;; frame any more, in which case the next sections are inserted
+ ;; in a new "line".
+ (with-current-buffer buf
(erase-buffer)
(dolist (block (nreverse blocks))
- (when (> (+ (car block) (current-column)) (frame-width))
+ (when (> (+ (car block) (current-column)) (frame-width))
(goto-char (point-max))
(newline 2))
- (save-excursion
+ (save-excursion
(insert-rectangle (cdr block)))
- (end-of-line))
+ (end-of-line))
(delete-trailing-whitespace)
(save-excursion
- (goto-char (point-min))
- (while-let ((match (text-property-search-forward 'quick-help-cmd)))
+ (goto-char (point-min))
+ (while-let ((match (text-property-search-forward 'quick-help-cmd)))
(make-text-button (prop-match-beginning match)
(prop-match-end match)
'mouse-face 'highlight
'button t
'keymap button-map
'action #'describe-symbol
- 'button-data (prop-match-value match)))))
+ 'button-data (prop-match-value match))))
- (help-mode)
+ (help-mode))
;; Display the buffer at the bottom of the frame...
- (with-selected-window (display-buffer-at-bottom (current-buffer) '())
+ (with-selected-window (display-buffer-at-bottom buf '())
;; ... mark it as dedicated to prevent focus from being stolen
(set-window-dedicated-p (selected-window) t)
;; ... and shrink it immediately.
- (fit-window-to-buffer))
- (message
- (substitute-command-keys "Toggle the quick help buffer using \\[help-quick-toggle]."))))
+ (fit-window-to-buffer)))
+ (message
+ (substitute-command-keys "Toggle the quick help buffer using \\[help-quick-toggle].")))
(defun help-quick-toggle ()
"Toggle the quick-help window."
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.