-(defun el-search--do-subsexps (pos do-fun &optional ret-fun bound)
- ;; In current buffer, for any expression start between POS and BOUND
- ;; or (point-max), in order, call two argument function DO-FUN with
- ;; the current sexp string and the ending position of the current
- ;; sexp. When done, with RET-FUN given, call it with no args and
- ;; return the result; else, return nil.
- (save-excursion
- (goto-char pos)
- (condition-case nil
- (while (< (point) (or bound (point-max)))
- (let* ((this-sexp-end (save-excursion (thing-at-point--end-of-sexp) (point)))
- (this-sexp-string (buffer-substring-no-properties (point) this-sexp-end)))
- (funcall do-fun this-sexp-string this-sexp-end)
- (el-search--skip-expression (read this-sexp-string))
- (el-search--ensure-sexp-start)))
- (end-of-buffer))
- (when ret-fun (funcall ret-fun))))
-
-(defun el-search--create-read-map (&optional pos)
- (let ((mapping '()))
- (el-search--do-subsexps
- (or pos (point))
- (lambda (sexp _) (push (cons (read sexp) sexp) mapping))
- (lambda () (nreverse mapping))
- (save-excursion (thing-at-point--end-of-sexp) (point)))))
-
-(defun el-search--repair-replacement-layout (printed mapping)
- (with-temp-buffer
- (insert printed)
- (el-search--do-subsexps
- (point-min)
- (lambda (sexp sexp-end)
- (when-let ((old (cdr (assoc (read sexp) mapping))))
- (delete-region (point) sexp-end)
- (when (string-match-p "\n" old)
- (unless (looking-back "^[[:space:]]*" (line-beginning-position))
- (insert "\n"))
- (unless (looking-at "[[:space:]\)]*$")
- (insert "\n")
- (backward-char)))
- (save-excursion (insert old))))
- (lambda () (buffer-substring (point-min) (point-max))))))
+(defun el-search--format-replacement (replacement original replace-expr-input splice)
+ ;; Return a printed representation of REPLACEMENT. Try to reuse the
+ ;; layout of subexpressions shared with the original (replaced)
+ ;; expression and the replace expression.
+ (if (and splice (not (listp replacement)))
+ (error "Expression to splice in is an atom")
+ (let ((orig-buffer (generate-new-buffer "orig-expr")))
+ (with-current-buffer orig-buffer
+ (emacs-lisp-mode)
+ (insert original)
+ (when replace-expr-input (insert "\n\n" replace-expr-input)))
+ (unwind-protect
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (insert (if splice
+ (mapconcat #'el-search--print replacement " ")
+ (el-search--print replacement)))
+ (goto-char 1)
+ (let (start this-sexp end orig-match-start orig-match-end done)
+ (while (and (< (point) (point-max))
+ (condition-case nil
+ (progn
+ (setq start (point)
+ this-sexp (read (current-buffer))
+ end (point))
+ t)
+ (end-of-buffer nil)))
+ (setq done nil orig-match-start nil)
+ (with-current-buffer orig-buffer
+ (goto-char 1)
+ (if (el-search--search-pattern `',this-sexp t)
+ (setq orig-match-start (point)
+ orig-match-end (progn (forward-sexp) (point)))
+ (setq done t)))
+ ;; find out whether we have a sequence of equal expressions
+ (while (and (not done)
+ (condition-case nil
+ (progn (setq this-sexp (read (current-buffer))) t)
+ ((invalid-read-syntax end-of-buffer end-of-file) nil)))
+ (if (with-current-buffer orig-buffer
+ (condition-case nil
+ (if (not (equal this-sexp (read (current-buffer))))
+ nil
+ (setq orig-match-end (point))
+ t)
+ ((invalid-read-syntax end-of-buffer end-of-file) nil)))
+ (setq end (point))
+ (setq done t)))
+ (if orig-match-start
+ (let ((match (with-current-buffer orig-buffer
+ (buffer-substring-no-properties orig-match-start
+ orig-match-end))))
+ (delete-region start end)
+ (goto-char start)
+ (when (string-match-p "\n" match)
+ (unless (looking-back "^[[:space:]\(]*" (line-beginning-position))
+ (insert "\n"))
+ (unless (looking-at "[[:space:]\)]*$")
+ (insert "\n")
+ (backward-char)))
+ (insert match))
+ (goto-char start)
+ (el-search--skip-expression nil t))
+ (condition-case nil
+ (el-search--ensure-sexp-start)
+ (end-of-buffer (goto-char (point-max))))))
+ (delete-trailing-whitespace (point-min) (point-max)) ;FIXME: this should not be necessary
+ (let ((result (buffer-substring (point-min) (point-max))))
+ (if (equal replacement (read result))
+ result
+ (error "Error in `el-search--format-replacement' - please make a bug report"))))
+ (kill-buffer orig-buffer)))))