From 23e8316ef7659b361157c0659bdb96a4bc9cb1e7 Mon Sep 17 00:00:00 2001
From: Damien Cassou <damien@cassou.me>
Date: Tue, 12 Sep 2023 08:28:37 +0200
Subject: [PATCH 3/3] Shorten docstrings generated by cl-defstruct (bug#65790)

* lisp/emacs-lisp/cl-macs.el (cl-defstruct): Split the first line of
generated docstrings if either the struct name or a field name is very
long. This reduces the likelihood of "docstring wider than 80
characters" errors.
---
 lisp/emacs-lisp/cl-macs.el             | 44 ++++++++++++++++++--------
 test/lisp/emacs-lisp/bytecomp-tests.el | 17 ++++++++++
 2 files changed, 48 insertions(+), 13 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index dc17f992660..ef00f9e4fe4 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3187,18 +3187,27 @@ cl-defstruct
               ;; The arg "cl-x" is referenced by name in e.g. pred-form
 	      ;; and pred-check, so changing it is not straightforward.
 	      (push `(,defsym ,accessor (cl-x)
-                       ,(concat
-                         ;; NB.  This will produce incorrect results
-                         ;; in some cases, as our coding conventions
-                         ;; says that the first line must be a full
-                         ;; sentence.  However, if we don't word wrap
-                         ;; we will have byte-compiler warnings about
-                         ;; overly long docstrings.  So we can't have
-                         ;; a perfect result here, and choose to avoid
-                         ;; the byte-compiler warnings.
-                         (internal--format-docstring-line
-                          "Access slot \"%s\" of `%s' struct CL-X." slot name)
-                         (if doc (concat "\n" doc) ""))
+                       ,(let ((long-docstring
+                               (format "Access slot \"%s\" of `%s' struct CL-X." slot name)))
+                          (concat
+                           ;; NB.  This will produce incorrect results
+                           ;; in some cases, as our coding conventions
+                           ;; says that the first line must be a full
+                           ;; sentence.  However, if we don't word
+                           ;; wrap we will have byte-compiler warnings
+                           ;; about overly long docstrings.  So we
+                           ;; can't have a perfect result here, and
+                           ;; choose to avoid the byte-compiler
+                           ;; warnings.
+                           (if (>= (length long-docstring) byte-compile-docstring-max-column)
+                               (concat
+                                (internal--format-docstring-line
+                                 "Access slot \"%s\" of CL-X." slot)
+                                "\n"
+                                (internal--format-docstring-line
+                                 "Struct CL-X is a `%s'." name))
+                             (internal--format-docstring-line long-docstring))
+                           (if doc (concat "\n" doc) "")))
                        (declare (side-effect-free t))
                        ,access-body)
                     forms)
@@ -3274,7 +3283,16 @@ cl-defstruct
 	(push `(,cldefsym ,cname
                    (&cl-defs (nil ,@descs) ,@args)
                  ,(if (stringp doc) doc
-                    (format "Constructor for objects of type `%s'." name))
+                    ;; NB.  This will produce incorrect results in
+                    ;; some cases, as our coding conventions says that
+                    ;; the first line must be a full sentence.
+                    ;; However, if we don't word wrap we will have
+                    ;; byte-compiler warnings about overly long
+                    ;; docstrings.  So we can't have a perfect result
+                    ;; here, and choose to avoid the byte-compiler
+                    ;; warnings.
+                    (internal--format-docstring-line
+                     "Constructor for objects of type `%s'." name))
                  ,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
                        '((declare (side-effect-free t))))
                  (,con-fun ,@make))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 102616c9bb7..03aed5263b6 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -983,6 +983,23 @@ bytecomp-warn-wide-docstring/cl-defsubst
    `(cl-defsubst long-name-with-more-than-80-characters-yes-this-is-a-very-long-name-but-why-not!! ()
       "Do something.")))
 
+(ert-deftest bytecomp-warn-wide-docstring/cl-defstruct ()
+  (bytecomp--without-warning-test
+   `(cl-defstruct short-name
+      field))
+  (bytecomp--without-warning-test
+   `(cl-defstruct short-name
+      long-name-with-less-80-characters-but-still-quite-a-bit))
+  (bytecomp--without-warning-test
+   `(cl-defstruct long-name-with-less-80-characters-but-still-quite-a-bit
+      field))
+  (bytecomp--with-warning-test "wider than.*characters"
+    `(cl-defstruct short-name
+       long-name-with-more-than-80-characters-yes-this-is-a-very-long-name-but-why-not!!))
+  (bytecomp--with-warning-test "wider than.*characters"
+    `(cl-defstruct long-name-with-more-than-80-characters-yes-this-is-a-very-long-name-but-why-not!!
+       field)))
+
 (ert-deftest bytecomp-warn-quoted-condition ()
   (bytecomp--with-warning-test
       "Warning: `condition-case' condition should not be quoted: 'arith-error"
-- 
2.41.0