bug#63861: [PATCH] pp.el: New "pretty printing" code

[Stefan Monnier]

> Yes, but let's also mention BEG and END:
>
>   Break lines in Lisp code between BEG and END so it fits within 
> `fill-column'.

Even better, thanks.

>> > Also, I think this warrants a NEWS entry and should be documented in
>> > the ELisp manual.
>> 
>> Definitely for NEWS, yes.  For the ELisp manual, currently we don't
>> document `pp-buffer`, the closest I see is `indent-pp-sexp` (in
>> `programs.texi`).
>> I'm not sure what to put in there. nor where to put it.
>
> We document "pp" in "Output Functions".  Maybe there?

Haven't looked at that yet: I'm still trying to figure out how the
functionality should be exposed.

>> >> +(defcustom pp-buffer-use-pp-region nil
>> >> +  "If non-nil, `pp-buffer' uses the new `pp-region' code."
>> >> +  :type 'boolean)
>> > Please add :version.
>> Hmm... so you think it should stay as a `defcustom` and we should thus
>> plan to keep both kinds of pretty-printing in the long term?
>
> No, I just said that _if_ we keep it as a defcustom, _then_ it should
> have a :version tag.  I have no idea how many users will want to
> customize this.

Since Emacs-29 already has a similar defcustom to use the
`pp-emacs-lisp-code` algorithm (and since Thierry uses yet another
algorithm), I guess there's enough evidence to convince me that we
should have a defcustom.

But I don't like the `pp-use-max-width` defcustom: its name doesn't say
what it does since the fact that `pp-emacs-lisp-code` obeys `pp-max-width`
is just one part of the difference with the default pp code.
So I suggest "merging" that var with the new custom var that chooses
which algorithm to use (I could make it an obsolete alias, but it seemed
cleaner to use a new var and mark the old one obsolete).

See below my new version of the patch.  I renamed `pp-region` to
`pp-fill`.  The patch introduces a custom var `pp-default-function`
which specifies which algorithm to use among:
- `pp-emacs-lisp-code` (Lars' new-in-29 pretty-but-slow pretty printer).
- `pp-fill` (my new pretty printer).
- `pp-28` (the old pretty printer; suggestions for a better name welcome).
- `pp-29` (dispatches according to `pp-use-max-width`, to either `pp-28`
  or `pp-emacs-lisp-code`, like we do in Emacs-29).
- Thierry could plug his `tv/pp-region` in here.

The patch also changes `pp` so you can call it with BEG..END and it will
pretty-print that region, which makes `pp-buffer` obsolete (I have not
yet updated the callers accordingly).

If there's no objection, I'll adjust the doc, fix the obsolete uses of
`pp-buffer`, and install.


        Stefan

diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index d44c9d6e23d..9914ededb85 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -876,7 +876,7 @@ lisp-ppss
 2 (counting from 0).  This is important for Lisp indentation."
   (unless pos (setq pos (point)))
   (let ((pss (syntax-ppss pos)))
-    (if (nth 9 pss)
+    (if (and (not (nth 2 pss)) (nth 9 pss))
         (let ((sexp-start (car (last (nth 9 pss)))))
           (parse-partial-sexp sexp-start pos nil nil (syntax-ppss sexp-start)))
       pss)))
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index e6e3cd6c6f4..28620fd4bbd 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -52,32 +52,195 @@
 large lists."
   :type 'boolean
   :version "29.1")
+(make-obsolete-variable 'pp-use-max-width 'pp-default-function "30.1")
+
+(defcustom pp-default-function #'pp-fill
+  ;; FIXME: The best pretty printer to use depends on the use-case
+  ;; so maybe we should allow callers to specify what they want (maybe with
+  ;; options like `fast', `compact', `code', `data', ...) and these
+  ;; can then be mapped to actual pretty-printing algorithms.
+  ;; Then again, callers can just directly call the corresponding function.
+  "Function that `pp' should dispatch to for pretty printing.
+That function can be called in one of two ways:
+- with a single argument, which it should insert and pretty-print at point.
+- with two arguments which delimit a region containing Lisp sexps
+  which should be pretty-printed.
+In both cases, the function can presume that the buffer is setup for
+Lisp syntax."
+  :type 'function
+  :options '(pp-28 pp-29 pp-fill pp-emacs-lisp-code)
+  :version "30.1")
 
 (defvar pp--inhibit-function-formatting nil)
 
+;; There are basically two APIs for a pretty-printing function:
+;;
+;; - either the function takes an object (and prints it in addition to
+;;   prettifying it).
+;; - or the function takes a region containing an already printed object
+;;   and prettifies its content.
+;;
+;; `pp--object' and `pp--region' are helper functions to convert one
+;; API to the other.
+
+
+(defun pp--object (object region-function)
+  "Pretty-print OBJECT at point.
+The prettifying is done by REGION-FUNCTION which is
+called with two positions as arguments and should fold lines
+within that region.  Returns the result as a string."
+  (let ((print-escape-newlines pp-escape-newlines)
+        (print-quoted t)
+        (beg (point)))
+    ;; FIXME: In many cases it would be preferable to use `cl-prin1' here.
+    (prin1 object (current-buffer))
+    (funcall region-function beg (point))))
+
+(defun pp--region (beg end object-function)
+  "Pretty-print the object(s) contained within BEG..END.
+OBJECT-FUNCTION is called with a single object as argument
+and should pretty print it at point into the current buffer."
+  (save-excursion
+    (with-restriction beg end
+      (goto-char (point-min))
+      (while
+          (progn
+            ;; We'll throw away all the comments within objects, but let's
+            ;; try at least to preserve the comments between objects.
+            (forward-comment (point-max))
+            (let ((beg (point))
+                  (object (ignore-error end-of-buffer
+                              (list (read (current-buffer))))))
+              (when (consp object)
+                (delete-region beg (point))
+                (funcall object-function (car object))
+                t)))))))
+
+(defun pp-29 (beg-or-sexp &optional end)
+  "Prettify the current region with printed representation of a Lisp object.
+Uses the pretty-printing algorithm that was standard in Emacs-29,
+which, depending on `pp-use-max-width', will either use `pp-28'
+or `pp-emacs-lisp-code'."
+  (if pp-use-max-width
+      (let ((pp--inhibit-function-formatting t)) ;FIXME: Why?
+        (pp-emacs-lisp-code beg-or-sexp end))
+    (pp-28 beg-or-sexp end)))
+
 ;;;###autoload
-(defun pp-to-string (object)
+(defun pp-to-string (object &optional pp-function)
   "Return a string containing the pretty-printed representation of OBJECT.
 OBJECT can be any Lisp object.  Quoting characters are used as needed
-to make output that `read' can handle, whenever this is possible."
-  (if pp-use-max-width
-      (let ((pp--inhibit-function-formatting t))
-        (with-temp-buffer
-          (pp-emacs-lisp-code object)
-          (buffer-string)))
+to make output that `read' can handle, whenever this is possible.
+Optional argument PP-FUNCTION overrides `pp-default-function'."
     (with-temp-buffer
       (lisp-mode-variables nil)
       (set-syntax-table emacs-lisp-mode-syntax-table)
-      (let ((print-escape-newlines pp-escape-newlines)
-            (print-quoted t))
-        (prin1 object (current-buffer)))
-      (pp-buffer)
-      (buffer-string))))
+    (funcall (or pp-function pp-default-function) object)
+    (buffer-string)))
+
+(defun pp--within-fill-column-p ()
+  "Return non-nil if point is within `fill-column'."
+  ;; Try and make it O(fill-column) rather than O(current-column),
+  ;; so as to avoid major slowdowns on long lines.
+  ;; FIXME: This doesn't account for invisible text or `display' properties :-(
+  (and (save-excursion
+         (re-search-backward
+          "^\\|\n" (max (point-min) (- (point) fill-column)) t))
+       (<= (current-column) fill-column)))
+
+(defun pp-fill (beg &optional end)
+  "Break lines in Lisp code between BEG and END so it fits within 
`fill-column'.
+Presumes the current buffer has syntax and indentation properly
+configured for that.
+Designed under the assumption that the region occupies a single line,
+tho it should also work if that's not the case.
+Can also be called with a single argument, in which case
+it inserts and pretty-prints that arg at point."
+  (interactive "r")
+  (if (null end) (pp--object beg #'pp-fill)
+    (goto-char beg)
+    (let ((end (copy-marker end t))
+          (newline (lambda ()
+                     (skip-chars-forward ")]}")
+                     (unless (save-excursion (skip-chars-forward " \t") (eolp))
+                       (insert "\n")
+                       (indent-according-to-mode)))))
+      (while (progn (forward-comment (point-max))
+                    (< (point) end))
+        (let ((beg (point))
+              ;; Whether we're in front of an element with paired delimiters.
+              ;; Can be something funky like #'(lambda ..) or ,'#s(...).
+              (paired (when (looking-at "['`,#]*[[:alpha:]]*\\([({[\"]\\)")
+                        (match-beginning 1))))
+          ;; Go to the end of the sexp.
+          (goto-char (or (scan-sexps (or paired (point)) 1) end))
+          (unless
+              (and
+               ;; The sexp is all on a single line.
+               (save-excursion (not (search-backward "\n" beg t)))
+               ;; And its end is within `fill-column'.
+               (or (pp--within-fill-column-p)
+                   ;; If the end of the sexp is beyond `fill-column',
+                   ;; try to move the sexp to its own line.
+                   (and
+                    (save-excursion
+                      (goto-char beg)
+                      (if (save-excursion (skip-chars-backward " \t({[',")
+                                          (bolp))
+                          ;; The sexp was already on its own line.
+                          nil
+                        (skip-chars-backward " \t")
+                        (setq beg (copy-marker beg t))
+                        (if paired (setq paired (copy-marker paired t)))
+                        ;; We could try to undo this insertion if it
+                        ;; doesn't reduce the indentation depth, but I'm
+                        ;; not sure it's worth the trouble.
+                        (insert "\n") (indent-according-to-mode)
+                        t))
+                    ;; Check again if we moved the whole exp to a new line.
+                    (pp--within-fill-column-p))))
+            ;; The sexp is spread over several lines, and/or its end is
+            ;; (still) beyond `fill-column'.
+            (when (and paired (not (eq ?\" (char-after paired))))
+              ;; The sexp has sub-parts, so let's try and spread
+              ;; them over several lines.
+              (save-excursion
+                (goto-char beg)
+                (when (looking-at "(\\([^][()\" \t\n;']+\\)")
+                  ;; Inside an expression of the form (SYM ARG1
+                  ;; ARG2 ... ARGn) where SYM has a `lisp-indent-function'
+                  ;; property that's a number, insert a newline after
+                  ;; the corresponding ARGi, because it tends to lead to
+                  ;; more natural and less indented code.
+                  (let* ((sym (intern-soft (match-string 1)))
+                         (lif (and sym (get sym 'lisp-indent-function))))
+                    (if (eq lif 'defun) (setq lif 2))
+                    (when (natnump lif)
+                      (goto-char (match-end 0))
+                      (forward-sexp lif)
+                      (funcall newline)))))
+              (save-excursion
+                (pp-fill (1+ paired) (1- (point)))))
+            ;; Now the sexp either ends beyond `fill-column' or is
+            ;; spread over several lines (or both).  Either way, the
+            ;; rest of the line should be moved to its own line.
+            (funcall newline)))))))
 
 ;;;###autoload
 (defun pp-buffer ()
   "Prettify the current buffer with printed representation of a Lisp object."
+  (declare (obsolete pp "30"))
   (interactive)
+  (pp (point-min) (point-max)))
+
+(defun pp-28 (beg &optional end)
+  "Prettify the current region with printed representation of a Lisp object.
+Uses the pretty-printing algorithm that was standard in Emacs≤29.
+Non-interactively can also be called with a single argument, in which
+case that argument will be inserted pretty-printed at point."
+  (interactive "r")
+  (if (null end) (pp--object beg #'pp-29)
+    (save-restriction beg end
   (goto-char (point-min))
   (while (not (eobp))
     (cond
@@ -98,7 +261,7 @@
       (insert ?\n))
      (t (goto-char (point-max)))))
   (goto-char (point-min))
-  (indent-sexp))
+      (indent-sexp))))
 
 ;;;###autoload
 (defun pp (object &optional stream)
@@ -106,14 +106,22 @@
 Quoting characters are printed as needed to make output that `read'
 can handle, whenever this is possible.
 
-This function does not apply special formatting rules for Emacs
-Lisp code.  See `pp-emacs-lisp-code' instead.
+Uses the pretty-printing code specified in `pp-default-function'.
 
-By default, this function won't limit the line length of lists
-and vectors.  Bind `pp-use-max-width' to a non-nil value to do so.
-
-Output stream is STREAM, or value of `standard-output' (which see)."
-  (princ (pp-to-string object) (or stream standard-output)))
+Output stream is STREAM, or value of `standard-output' (which see).
+An alternative calling convention is to pass it two buffer positions,
+in which case it will prettify that region's content."
+  (cond
+   ((and (integerp object) (integerp stream))
+    (funcall pp-default-function object stream))
+   ((and (eq (or stream standard-output) (current-buffer))
+         ;; Make sure the current buffer is setup sanely.
+         (eq (syntax-table) emacs-lisp-mode-syntax-table)
+         (eq indent-line-function #'lisp-indent-line))
+    ;; Skip the buffer->string->buffer middle man.
+    (funcall pp-default-function object))
+   (t
+    (princ (pp-to-string object) (or stream standard-output)))))
 
 ;;;###autoload
 (defun pp-display-expression (expression out-buffer-name &optional lisp)
@@ -220,11 +220,14 @@
     (pp-macroexpand-expression (pp-last-sexp))))
 
 ;;;###autoload
-(defun pp-emacs-lisp-code (sexp)
+(defun pp-emacs-lisp-code (sexp &optional end)
   "Insert SEXP into the current buffer, formatted as Emacs Lisp code.
 Use the `pp-max-width' variable to control the desired line length.
-Note that this could be slow for large SEXPs."
+Note that this could be slow for large SEXPs.
+Can also be called with two arguments, in which case they're taken to be
+the bounds of a region containing Lisp code to pretty-print."
   (require 'edebug)
+  (if end (pp--region sexp end #'pp-emacs-lisp-code)
   (let ((obuf (current-buffer)))
     (with-temp-buffer
       (emacs-lisp-mode)
@@ -234,7 +237,7 @@
       (indent-sexp)
       (while (re-search-forward " +$" nil t)
         (replace-match ""))
-      (insert-into-buffer obuf))))
+        (insert-into-buffer obuf)))))
 
 (defun pp--insert-lisp (sexp)
   (cl-case (type-of sexp)