bug#69168: [BUG] 30.0.50; pp-emacs-lisp-code produces invalid elisp for backquoted forms

[Michael Heerdegen]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> One from me: I'm working on a second patch for pp that will make
> printing of backquote forms using the nicer `X syntax.

Here is the additional patch.  No Wayman, maybe you can try if it gives
good results?

This change seems quite straightforward, and I tried to avoid to make
the code less efficient.  For me, it seems to give good results.
Please (Eli), if names and comments are bad English, please feel free to
suggest a better wording.

From a6ad2e056b7ac136ac766b1fcdb5f59f2f505e15 Mon Sep 17 00:00:00 2001
From: Michael Heerdegen <michael_heerdegen@web.de>
Date: Sun, 18 Feb 2024 01:55:54 +0100
Subject: [PATCH] WIP: Improve pp-emacs-lisp-code backquote form printing

* lisp/emacs-lisp/pp.el (pp--quoted-or-unquoted-form-p): New helper
function.
(pp--insert-lisp): Take care of quoted, backquoted and
unquoted expressions; print using an recursive call.
(pp--format-list): Exclude more cases from printing as a function call
by default.  Print lists whose second-last element is an (un)quoting
symbol using dotted list syntax; e.g. (a b . ,c) instead of (a b \, c).
---
 lisp/emacs-lisp/pp.el | 56 ++++++++++++++++++++++++++++++-------------
 1 file changed, 40 insertions(+), 16 deletions(-)

diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 944dd750839..045cc171eaa 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -430,23 +430,33 @@ pp-emacs-lisp-code
           (replace-match ""))
         (insert-into-buffer obuf)))))

+(defvar pp--quoting-syntaxes
+  `((quote    . "'")
+    (function . "#'")
+    (,backquote-backquote-symbol . "`")
+    (,backquote-unquote-symbol   . ",")
+    (,backquote-splice-symbol    . ",@")))
+
+(defun pp--quoted-or-unquoted-form-p (cons)
+  ;; Return non-nil when CONS has one of the forms 'X, `X, ,X or ,@X
+  (let ((head (car cons)))
+    (and (symbolp head)
+         (assq head pp--quoting-syntaxes)
+         (let ((rest (cdr cons)))
+           (and (consp rest) (null (cdr rest)))))))
+
 (defun pp--insert-lisp (sexp)
   (cl-case (type-of sexp)
     (vector (pp--format-vector sexp))
     (cons (cond
            ((consp (cdr sexp))
-            (if (and (length= sexp 2)
-                     (memq (car sexp) '(quote function)))
-                (cond
-                 ((symbolp (cadr sexp))
-                  (let ((print-quoted t))
-                    (prin1 sexp (current-buffer))))
-                 ((consp (cadr sexp))
-                  (insert (if (eq (car sexp) 'quote)
-                              "'" "#'"))
-                  (pp--format-list (cadr sexp)
-                                   (set-marker (make-marker) (1- (point))))))
-              (pp--format-list sexp)))
+            (let ((head (car sexp)))
+              (if-let (((null (cddr sexp)))
+                       (syntax-entry (assq head pp--quoting-syntaxes)))
+                  (progn
+                    (insert (cdr syntax-entry))
+                    (pp--insert-lisp (cadr sexp)))
+                (pp--format-list sexp))))
            (t
             (prin1 sexp (current-buffer)))))
     ;; Print some of the smaller integers as characters, perhaps?
@@ -470,15 +480,29 @@ pp--format-vector
   (insert "]"))

 (defun pp--format-list (sexp &optional start)
-  (if (and (symbolp (car sexp))
-           (not pp--inhibit-function-formatting)
-           (not (keywordp (car sexp))))
+  (if (not (let ((head (car sexp)))
+             (or pp--inhibit-function-formatting
+                 (not (symbolp head))
+                 (keywordp head)
+                 (let ((l sexp))
+                   (catch 'not-funcall
+                     (while l
+                       (when (or
+                              (not (consp l)) ; SEXP is a dotted list
+                              ;; Is SEXP is of a form like (ELT... . ,X) ?
+                              (pp--quoted-or-unquoted-form-p l))
+                         (throw 'not-funcall t))
+                       (setq l (cdr l)))
+                     nil)))))
       (pp--format-function sexp)
     (insert "(")
     (pp--insert start (pop sexp))
     (while sexp
       (if (consp sexp)
-          (pp--insert " " (pop sexp))
+          (if (not (pp--quoted-or-unquoted-form-p sexp))
+              (pp--insert " " (pop sexp))
+            (pp--insert " . " sexp)
+            (setq sexp nil))
         (pp--insert " . " sexp)
         (setq sexp nil)))
     (insert ")")))
--
2.39.2


Michael.