bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#68236: [PATCH] help.el: allow help-quick to use local commands/quick


From: JD Smith
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."







reply via email to

[Prev in Thread] Current Thread [Next in Thread]