Subject: bug#61877: closed (Re: bug#61877: [PATCH] Extract Lisp function examples from shortdoc information)

From: [email-masked] (GNU bug Tracking System)
Date: Wed, 06 Sep 2023 00:04:02 +0000

Your bug report

#61877: [PATCH] Extract Lisp function examples from shortdoc information

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
61877: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=61877
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#61877: [PATCH] Extract Lisp function examples from shortdoc information
From: Stefan Kangas <[email-masked]>
To: Eli Zaretskii <[email-masked]>
Cc: [email-masked],Daniel Martín <[email-masked]>
Date: Tue, 5 Sep 2023 17:03:39 -0700
List-Id: <debbugs-submit.debbugs.gnu.org>

Eli Zaretskii <[email-masked]> writes:

>> Could you give a try to the attached patch, and install it for me if all
>> works correctly?  Thanks.
>
> It works here; I installed it.

I'm therefore closing this bug report.

Subject: [PATCH] Extract Lisp function examples from shortdoc information
From: Daniel Martín <[email-masked]>
To: [email-masked]
Date: Tue, 28 Feb 2023 23:36:09 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

Shortdoc contains a lot of useful examples about how to use common ELisp
functions.  This patch explores a new Emacs feature where those examples
are identified and extracted so they can be displayed, perhaps, in
*Help* buffers (via an additional help-fns-describe-function-functions
hook).

After you install the attached patch, take a look at the *Help* buffer
produced by C-h f assq RET, or C-h f match-string RET, etc.

What do you think of having this new Lisp feature in Emacs 30?  I can
send later another patch with tests, relevant NEWS entries and
documentation changes.

Thanks.

>From da859693ba9fafd0ba43107bc99dba5464ac3ab6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Mart=C3=ADn?= <[email-masked]>
Date: Tue, 28 Feb 2023 23:15:40 +0100
Subject: [PATCH] Extract Lisp function examples from shortdoc information

* lisp/emacs-lisp/shortdoc.el (shortdoc--display-function): Add a new
shortdoc-example text property so that ELisp examples can be searched
for later.
(shortdoc--insert-group-in-buffer): New function extracted from the
buffer insertion code in shortdoc-display-group.
(shortdoc-display-group): Implement in terms of
shortdoc--insert-group-in-buffer.
* lisp/help-fns.el (help-fns--shortdoc-example): Add a new
help-fns-describe-function-functions hook that displays example code
for functions documented in shortdoc groups.
---
 lisp/emacs-lisp/shortdoc.el | 80 ++++++++++++++++++++-----------------
 lisp/help-fns.el            | 28 +++++++++++++
 2 files changed, 72 insertions(+), 36 deletions(-)

diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index c49960c2ee6..4e19cd04c9e 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1443,45 +1443,51 @@ shortdoc-display-group
     (setq group (intern group)))
   (unless (assq group shortdoc--groups)
     (error "No such documentation group %s" group))
-  (funcall (if same-window
-               #'pop-to-buffer-same-window
-             #'pop-to-buffer)
-           (format "*Shortdoc %s*" group))
-  (let ((inhibit-read-only t)
-        (prev nil))
-    (erase-buffer)
-    (shortdoc-mode)
-    (button-mode)
-    (mapc
-     (lambda (data)
-       (cond
-        ((stringp data)
-         (setq prev nil)
-         (unless (bobp)
-           (insert "\n"))
-         (insert (propertize
-                  (substitute-command-keys data)
-                  'face 'shortdoc-heading
-                  'shortdoc-section t
-                  'outline-level 1))
-         (insert (propertize
-                  "\n\n"
-                  'face 'shortdoc-heading
-                  'shortdoc-section t)))
-        ;; There may be functions not yet defined in the data.
-        ((fboundp (car data))
-         (when prev
-           (insert (make-separator-line)
-                   ;; This helps with hidden outlines (bug#53981)
-                   (propertize "\n" 'face '(:height 0))))
-         (setq prev t)
-         (shortdoc--display-function data))))
-     (cdr (assq group shortdoc--groups))))
+  (let ((buf (get-buffer-create (format "*Shortdoc %s*" group))))
+    (shortdoc--insert-group-in-buffer group buf)
+    (funcall (if same-window
+                 #'pop-to-buffer-same-window
+               #'pop-to-buffer)
+             buf))
   (goto-char (point-min))
   (when function
     (text-property-search-forward 'shortdoc-function function t)
     (beginning-of-line)))
 
+(defun shortdoc--insert-group-in-buffer (group &optional buf)
+  "Insert a short documentation summary for functions in GROUP in buffer BUF."
+  (with-current-buffer (or buf (current-buffer))
+    (let ((inhibit-read-only t)
+          (prev nil))
+      (erase-buffer)
+      (shortdoc-mode)
+      (button-mode)
+      (mapc
+       (lambda (data)
+         (cond
+          ((stringp data)
+           (setq prev nil)
+           (unless (bobp)
+             (insert "\n"))
+           (insert (propertize
+                    (substitute-command-keys data)
+                    'face 'shortdoc-heading
+                    'shortdoc-section t
+                    'outline-level 1))
+           (insert (propertize
+                    "\n\n"
+                    'face 'shortdoc-heading
+                    'shortdoc-section t)))
+          ;; There may be functions not yet defined in the data.
+          ((fboundp (car data))
+           (when prev
+             (insert (make-separator-line)
+                     ;; This helps with hidden outlines (bug#53981)
+                     (propertize "\n" 'face '(:height 0))))
+           (setq prev t)
+           (shortdoc--display-function data))))
+       (cdr (assq group shortdoc--groups))))))
+
 ;;;###autoload
 (defalias 'shortdoc #'shortdoc-display-group)
 
@@ -1521,7 +1527,8 @@ shortdoc--display-function
                           "=>"))
           (single-arrow (if (char-displayable-p ?→)
                             "→"
-                          "->")))
+                          "->"))
+          (start-example (point)))
       (cl-loop for (type value) on data by #'cddr
                do
                (cl-case type
@@ -1572,7 +1579,8 @@ shortdoc--display-function
                  (:eg-result-string
                   (insert "    e.g. " double-arrow " ")
                   (princ value (current-buffer))
-                  (insert "\n")))))
+                  (insert "\n"))))
+      (add-text-properties start-example (point) `(shortdoc-example ,function)))
     ;; Insert the arglist after doing the evals, in case that's pulled
     ;; in the function definition.
     (save-excursion
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 50e60b68e17..843de957a5f 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -954,6 +954,34 @@ help-fns--mention-shortdoc-groups
         (fill-region-as-paragraph (point-min) (point-max))
         (goto-char (point-max))))))
 
+(add-hook 'help-fns-describe-function-functions
+          #'help-fns--shortdoc-example)
+(defun help-fns--shortdoc-example (object)
+  (require 'shortdoc)
+  (when-let ((groups (and (symbolp object)
+                          (shortdoc-function-groups object)))
+             (times 0))
+    (mapc
+     (lambda (group)
+       (let ((buf (current-buffer)))
+         (with-temp-buffer
+           (shortdoc--insert-group-in-buffer group)
+           (goto-char (point-min))
+           (setq match (text-property-search-forward
+                        'shortdoc-example object t))
+           (let ((temp-buffer (current-buffer)))
+             (with-current-buffer buf
+               (when (zerop times)
+                 (if (eq (length groups) 1)
+                     (insert "  Example:\n\n")
+                   (insert "  Examples:\n\n")))
+               (setq times (1+ times))
+               (insert-buffer-substring temp-buffer
+                                        (prop-match-beginning match)
+                                        (prop-match-end match))
+               (insert "\n"))))))
+     groups)))
+
 (defun help-fns-short-filename (filename)
   (let* ((abbrev (abbreviate-file-name filename))
          (short abbrev))
-- 
2.34.1