>From da859693ba9fafd0ba43107bc99dba5464ac3ab6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Mart=C3=ADn?= <mardani29@yahoo.es>
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