unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#68236: [PATCH] help.el: allow help-quick to use local commands/quick-sections
@ 2024-01-04  3:08 JD Smith
  2024-01-04  7:39 ` Eli Zaretskii
  0 siblings, 1 reply; 13+ messages in thread
From: JD Smith @ 2024-01-04  3:08 UTC (permalink / raw)
  To: 68236

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."







^ permalink raw reply	[flat|nested] 13+ messages in thread

end of thread, other threads:[~2024-01-10 22:49 UTC | newest]

Thread overview: 13+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-01-04  3:08 bug#68236: [PATCH] help.el: allow help-quick to use local commands/quick-sections JD Smith
2024-01-04  7:39 ` 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

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).