[elpa] scratch/mheerdegen-preview 2f72331 08/35: WIP: New file el-search/el-search-pp.el

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 2f72331f59671aff5ecad33c613960e0c86050d8
Author: Michael Heerdegen <address@hidden>
Commit: Michael Heerdegen <address@hidden>

    WIP: New file el-search/el-search-pp.el
---
 packages/el-search/el-search-pp.el | 135 +++++++++++++++++++++++++++++++++++++
 packages/el-search/el-search.el    |  15 +++--
 2 files changed, 146 insertions(+), 4 deletions(-)

diff --git a/packages/el-search/el-search-pp.el 
b/packages/el-search/el-search-pp.el
new file mode 100644
index 0000000..053401f
--- /dev/null
+++ b/packages/el-search/el-search-pp.el
@@ -0,0 +1,135 @@
+;;; el-search-pp.el --- Further prettifications for pp with means of el-search 
-*- lexical-binding:t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc
+
+;; Author: Michael Heerdegen <address@hidden>
+;; Maintainer: Michael Heerdegen <address@hidden>
+;; Created: 2018_01_14
+;; Keywords: lisp
+
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+
+;; This files provides a minor mode `el-search-pretty-pp-mode' that
+;; enhances pp.el to produce even prettier results.  Since
+;; el-search-query-replace uses pp to format replacement, this has
+;; also an effect on the insertions done by this command.
+;;
+;;
+;; Bugs, Known Limitations:
+;;
+;; This doesn't work with `cl-print'ed contents
+
+
+
+;;; Code:
+
+(require 'el-search)
+(require 'el-search-x)
+
+(defun el-search-prettify-let-likes ()
+  ;; Remove possible line break directly after the macro name
+  (let ((let-like-matcher (el-search-make-matcher 
el-search--match-let-like-pattern)))
+    (save-excursion
+      (while (el-search--search-pattern-1 let-like-matcher t)
+        (when (looking-at "(\\(\\_<\\(\\w\\|\\s_\\)+\\_>\\*?\\) *\n")
+          (save-excursion
+            (goto-char (match-end 1))
+            (delete-region
+             (point)
+             (progn (skip-chars-forward " \t\n") (point)))
+            (insert " "))
+          (indent-sexp))
+        (el-search--skip-expression nil 'read)))))
+
+(defun el-search-prettify-let-like-bindings ()
+  (let ((let-like-binding-matcher (el-search-make-matcher '(and 
(let-like-binding) `(,_ ,_)))))
+    (save-excursion
+      (while (el-search--search-pattern-1 let-like-binding-matcher t)
+        (let ((deleted-line-break nil))
+          (save-excursion
+            (when (setq deleted-line-break
+                        (progn (down-list 1)
+                               (goto-char (scan-sexps (point) 1))
+                               (looking-at "[\s\t]*\n[\s\t]+")))
+              (delete-region (match-beginning 0) (match-end 0))
+              (insert " ")))
+          (when deleted-line-break (indent-sexp))
+          (el-search--skip-expression nil 'read))))))
+
+(defun el-search-prettify-huge-lists ()
+  (save-excursion
+    (while (el-search--search-pattern-1 (el-search-make-matcher '(pred listp)) 
t nil)
+      (pcase-let ((`(,this-list ,bound) (save-excursion (list (el-search-read 
(current-buffer))
+                                                              (copy-marker 
(point))))))
+        (when (and (not (macrop (car this-list))) ; FIXME: find a solution for 
funs and macros
+                   (or
+                    (< 60 (- bound (point)))
+                    (and
+                     (null (cdr (last this-list))) ;FIXME: what about dotted 
or circular lists?
+                     (nthcdr 10 this-list)
+                     (not (cl-every (lambda (elt) (and (atom elt) (not 
(stringp elt))))
+                                    this-list)))))
+          (save-excursion
+            (down-list 1)
+            (while (el-search-forward '_ bound t)
+              (goto-char (scan-sexps (point) 1))
+              (unless (or (looking-at "$") (not (save-excursion 
(el-search-forward '_ bound t))))
+                (insert "\n"))))
+          (indent-sexp)))
+      (el-search--skip-expression nil 'read)))
+  (indent-sexp))
+
+(defun el-search-prettify-tiny-lists ()
+  (save-excursion
+    (while (el-search--search-pattern-1 (el-search-make-matcher '(pred listp)) 
t nil)
+      (pcase-let ((bound (copy-marker (scan-sexps (point) 1))))
+        (when (and (< (count-matches "[^[:space:]]" (point) bound) 45)
+                   (save-excursion (search-forward-regexp "\n" bound t)))
+          (save-excursion
+            (while (search-forward-regexp "\n[[:space:]]*" bound t)
+              (replace-match " ")))
+          (indent-sexp)))
+      (el-search--skip-expression nil 'read)))
+  (indent-sexp))
+
+
+(defvar el-search-prettify-functions
+  '(el-search-prettify-let-likes
+    el-search-prettify-let-like-bindings
+    el-search-prettify-huge-lists
+    el-search-prettify-tiny-lists))
+
+(defgroup el-search-pp '() "Doc..." :group 'el-search)
+
+(defcustom el-search-pretty-pp nil
+  "Doc..."
+  :type 'boolean)
+
+(defun el-search-pp-buffer ()
+  (emacs-lisp-mode)
+  (goto-char (point-min))
+  (mapc (lambda (fun) (save-excursion (funcall fun)))
+        el-search-prettify-functions))
+
+
+(provide 'el-search-pp)
+
+;;; el-search-pp.el ends here
+
diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 66a3556..8838e33 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -433,9 +433,6 @@
 ;;   (ambiguous reader syntaxes; lost comments, comments that can't
 ;;   non-ambiguously be assigned to rewritten code)
 ;;
-;; - There could be something much better than pp to format the
-;;   replacement, or pp should be improved.
-;;
 ;;
 ;; NEWS:
 ;;
@@ -769,11 +766,21 @@ nil."
           (read stream)))
     #'read))
 
+(defvar el-search-pretty-pp)
+(declare-function el-search-pp-buffer 'el-search-pp)
+
 (defun el-search--pp-to-string (expr)
   (let ((print-length nil)
         (print-level nil)
         (print-circle nil))
-    (string-trim-right (pp-to-string expr))))
+    (let ((result (pp-to-string expr)))
+      (when el-search-pretty-pp
+        (setq result
+              (with-temp-buffer
+                (insert result)
+                (el-search-pp-buffer)
+                (buffer-string))))
+      (string-trim-right result))))
 
 (defun el-search--setup-minibuffer ()
   (let ((inhibit-read-only t))