From: JD Smith <jdtsmith@gmail.com>
To: 68236@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 [thread overview]
Message-ID: <1B0F351A-C393-4C1B-B883-814F2C33E802@gmail.com> (raw)
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."
next reply other threads:[~2024-01-04 3:08 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-01-04 3:08 JD Smith [this message]
2024-01-04 7:39 ` bug#68236: [PATCH] help.el: allow help-quick to use local commands/quick-sections Eli Zaretskii
2024-01-04 13:45 ` JD Smith
2024-01-04 13:57 ` Eli Zaretskii
2024-01-05 1:28 ` JD Smith
2024-01-05 8:40 ` Eli Zaretskii
2024-01-05 17:00 ` JD Smith
2024-01-10 12:51 ` Stefan Kangas
2024-01-10 13:53 ` Eli Zaretskii
2024-01-10 15:46 ` JD Smith
2024-01-10 15:50 ` Stefan Kangas
2024-01-10 15:58 ` Eli Zaretskii
2024-01-10 22:49 ` JD Smith
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1B0F351A-C393-4C1B-B883-814F2C33E802@gmail.com \
--to=jdtsmith@gmail.com \
--cc=68236@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).