branch: scratch/mheerdegen-preview
commit 216fd0646246e9243283dbf7e1d223de41fd5c07
Author: Michael Heerdegen <michael_heerde...@web.de>
Commit: Michael Heerdegen <michael_heerde...@web.de>
WIP: New file el-search/el-search-pp.el
---
packages/el-search/el-search-pp.el | 133 +++++++++++++++++++++++++++++++++++++
packages/el-search/el-search.el | 15 +++--
2 files changed, 144 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..53112a3
--- /dev/null
+++ b/packages/el-search/el-search-pp.el
@@ -0,0 +1,133 @@
+;;; 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 <michael_heerde...@web.de>
+;; Maintainer: Michael Heerdegen <michael_heerde...@web.de>
+;; 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 (or (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)))
+ (< 60 (- bound (point))))
+ (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 297af5e..efb9033 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))
