Improve indentation and column preservation in `paredit-splice'.

2 files changed, 174 insertions, 16 deletions

diff --git a/paredit.el b/paredit.el
index 5e91197..1adbe45 100644
--- a/paredit.el
+++ b/paredit.el
@@ -2032,23 +2032,43 @@ Inside a string, unescape all backslashes, or signal an error if doing
   (interactive "P")
   (if (paredit-in-string-p)
       (paredit-splice-string argument)
-      (save-excursion
-        (paredit-kill-surrounding-sexps-for-splice argument)
-        (let ((end (point)))
-          (backward-up-list)            ; Go up to the beginning...
-          (save-excursion
-            (forward-char 1)            ; (Skip over leading whitespace
-            (paredit-skip-whitespace t end)
-            (setq end (point)))         ;   for the `delete-region'.)
-          (let ((indent-start nil) (indent-end nil))
+    (if (paredit-in-comment-p)
+        (error "Can't splice comment."))
+    (paredit-handle-sexp-errors (paredit-enclosing-list-start)
+      (error "Can't splice top level."))
+    (paredit-kill-surrounding-sexps-for-splice argument)
+    (let ((delete-start (paredit-enclosing-list-start))
+          (delete-end
+           (let ((limit
+                  (save-excursion
+                    (paredit-ignore-sexp-errors (forward-sexp) (backward-sexp))
+                    (point))))
+             (save-excursion
+               (backward-up-list)
+               (forward-char +1)
+               (paredit-skip-whitespace t limit)
+               (point)))))
+      (let ((end-marker (make-marker)))
+        (save-excursion
+          (up-list)
+          (backward-delete-char +1)
+          (set-marker end-marker (point)))
+        (delete-region delete-start delete-end)
+        (paredit-splice-reindent delete-start (marker-position end-marker))))))
+
+(defun paredit-splice-reindent (start end)
+  (paredit-preserving-column
+    ;; If we changed the first subform of the enclosing list, we must
+    ;; reindent the whole enclosing list.
+    (if (paredit-handle-sexp-errors
             (save-excursion
-              (setq indent-start (point))
-              (forward-sexp)            ; Go forward an expression, to
-              (backward-delete-char 1)  ;   delete the end delimiter.
-              (setq indent-end (point)))
-            (delete-region (point) end) ; ...to delete the open char.
-            ;; Reindent only the region we preserved.
-            (indent-region indent-start indent-end nil))))))
+              (backward-up-list)
+              (down-list)
+              (paredit-ignore-sexp-errors (forward-sexp))
+              (< start (point)))
+          nil)
+        (save-excursion (backward-up-list) (indent-sexp))
+        (paredit-indent-region start end))))
 
 (defun paredit-kill-surrounding-sexps-for-splice (argument)
   (cond ((or (paredit-in-string-p)
diff --git a/test.el b/test.el
index d46aa13..c610ba4 100644
--- a/test.el
+++ b/test.el
@@ -1035,6 +1035,144 @@ Four arguments: the paredit command, the text of the buffer
     ("(foo |(bar #\\x \"baz \\\\ quux\") zot)"
      "(foo \"|(bar #\\\\x \\\"baz \\\\\\\\ quux\\\")\" zot)")))
 
+(paredit-test 'paredit-splice-sexp
+  '(("|(f (g\n    h))" error)
+    ("(|f (g\n    h))" "|f (g\n   h)")
+    ("(f| (g\n    h))" "f| (g\n   h)")
+    ("(f |(g\n    h))" "f |(g\n   h)")
+    ("(f (|g\n    h))" "(f |g\n   h)")
+    ("(f (g|\n    h))" "(f g|\n   h)")
+    ("(f (g\n|    h))" "(f g\n|   h)")
+    ("(f (g\n |   h))" "(f g\n |  h)")
+    ("(f (g\n  |  h))" "(f g\n  | h)")
+    ("(f (g\n   | h))" "(f g\n   |h)")
+    ("(f (g\n    |h))" "(f g\n   |h)")
+    ("(f (g\n    h|))" "(f g\n   h|)")
+    ("(f (g\n    h)|)" "f (g\n   h)|")
+    ("(f (g\n    h))|" error)
+
+    ;; Omit whitespace if appropriate.
+    ("|(f (\n    h))" error)
+    ("(|f (\n    h))" "|f (\n   h)")
+    ("(f| (\n    h))" "f| (\n   h)")
+    ("(f |(\n    h))" "f |(\n   h)")
+    ("(f (|\n    h))" "(f |h)")
+    ("(f (\n|    h))" "(f |h)")
+    ("(f (\n |   h))" "(f |h)")
+    ("(f (\n  |  h))" "(f |h)")
+    ("(f (\n   | h))" "(f |h)")
+    ("(f (\n    |h))" "(f |h)")
+    ("(f (\n    h|))" "(f h|)")
+    ("(f (\n    h)|)" "f (\n   h)|")
+    ("(f (\n    h))|" error)
+
+    ;; But leave comments intact.
+    ("(f (|   ;xy\n    h))" "(f |;xy\n h)")
+    ("(f ( |  ;xy\n    h))" "(f |;xy\n h)")
+    ("(f (  | ;xy\n    h))" "(f |;xy\n h)")
+    ("(f (   |;xy\n    h))" "(f |;xy\n h)")
+    ("(f (   ;|xy\n    h))" error)
+    ("(f (   ;x|y\n    h))" error)
+    ("(f (   ;xy|\n    h))" error)
+    ("(f (   ;xy\n|    h))" "(f ;xy\n| h)")
+    ("(f (   ;xy\n |   h))" "(f ;xy\n |h)")
+    ("(f (   ;xy\n  |  h))" "(f ;xy\n |h)")
+    ("(f (   ;xy\n   | h))" "(f ;xy\n |h)")
+    ("(f (   ;xy\n    |h))" "(f ;xy\n |h)")
+    ("(f (   ;xy\n    h|))" "(f ;xy\n h|)")
+
+    ;; Don't touch indentation outside a limited scope.
+    ("(foo (|bar)\n          baz)" "(foo |bar\n          baz)")
+    ("(foo (b|ar)\n          baz)" "(foo b|ar\n          baz)")
+    ("(foo (ba|r)\n          baz)" "(foo ba|r\n          baz)")
+    ("(foo (bar|)\n          baz)" "(foo bar|\n          baz)")
+    ("  (foo\n  (|bar baz))" "  (foo\n  |bar baz)")
+    ("  (foo\n  (b|ar baz))" "  (foo\n  b|ar baz)")
+    ("  (foo\n  (ba|r baz))" "  (foo\n  ba|r baz)")
+    ("  (foo\n  (bar| baz))" "  (foo\n  bar| baz)")
+    ("  (foo\n  (bar |baz))" "  (foo\n  bar |baz)")
+    ("  (foo\n  (bar b|az))" "  (foo\n  bar b|az)")
+    ("  (foo\n  (bar ba|z))" "  (foo\n  bar ba|z)")
+    ("  (foo\n  (bar baz|))" "  (foo\n  bar baz|)")
+    ("  (foo (|(bar\n         baz)\n        quux)\n zot)"
+     "  (foo |(bar\n        baz)\n       quux\n zot)")
+    ("  (foo ((|bar\n         baz)\n        quux)\n zot)"
+     "  (foo (|bar\n        baz\n        quux)\n zot)")
+    ("  (foo ((b|ar\n         baz)\n        quux)\n zot)"
+     "  (foo (b|ar\n        baz\n        quux)\n zot)")
+    ("  (foo ((ba|r\n         baz)\n        quux)\n zot)"
+     "  (foo (ba|r\n        baz\n        quux)\n zot)")
+    ("  (foo ((ba|r\n         baz)\n        quux)\n zot)"
+     "  (foo (ba|r\n        baz\n        quux)\n zot)")
+    ("  (foo ((bar|\n         baz)\n        quux)\n zot)"
+     "  (foo (bar|\n        baz\n        quux)\n zot)")
+    ("  (foo ((bar\n|         baz)\n        quux)\n zot)"
+     "  (foo (bar\n|        baz\n        quux)\n zot)")
+    ("  (foo ((bar\n |        baz)\n        quux)\n zot)"
+     "  (foo (bar\n |       baz\n        quux)\n zot)")
+    ("  (foo ((bar\n  |       baz)\n        quux)\n zot)"
+     "  (foo (bar\n  |      baz\n        quux)\n zot)")
+    ("  (foo ((bar\n   |      baz)\n        quux)\n zot)"
+     "  (foo (bar\n   |     baz\n        quux)\n zot)")
+    ("  (foo ((bar\n    |     baz)\n        quux)\n zot)"
+     "  (foo (bar\n    |    baz\n        quux)\n zot)")
+    ("  (foo ((bar\n     |    baz)\n        quux)\n zot)"
+     "  (foo (bar\n     |   baz\n        quux)\n zot)")
+    ("  (foo ((bar\n      |   baz)\n        quux)\n zot)"
+     "  (foo (bar\n      |  baz\n        quux)\n zot)")
+    ("  (foo ((bar\n       |  baz)\n        quux)\n zot)"
+     "  (foo (bar\n       | baz\n        quux)\n zot)")
+    ("  (foo ((bar\n        | baz)\n        quux)\n zot)"
+     "  (foo (bar\n        |baz\n        quux)\n zot)")
+    ("  (foo ((bar\n         |baz)\n        quux)\n zot)"
+     "  (foo (bar\n        |baz\n        quux)\n zot)")
+
+    ("  (foo ((bar\n         b|az)\n        quux)\n zot)"
+     "  (foo (bar\n        b|az\n        quux)\n zot)")
+    ("  (foo ((bar\n         ba|z)\n        quux)\n zot)"
+     "  (foo (bar\n        ba|z\n        quux)\n zot)")
+    ("  (foo ((bar\n         baz|)\n        quux)\n zot)"
+     "  (foo (bar\n        baz|\n        quux)\n zot)")
+    ("  (foo ((bar\n         baz)|\n        quux)\n zot)"
+     "  (foo (bar\n        baz)|\n       quux\n zot)")
+    ("  (foo ((bar\n         baz)\n|        quux)\n zot)"
+     "  (foo (bar\n        baz)\n|       quux\n zot)")
+    ("  (foo ((bar\n         baz)\n |       quux)\n zot)"
+     "  (foo (bar\n        baz)\n |      quux\n zot)")
+    ("  (foo ((bar\n         baz)\n  |      quux)\n zot)"
+     "  (foo (bar\n        baz)\n  |     quux\n zot)")
+    ("  (foo ((bar\n         baz)\n   |     quux)\n zot)"
+     "  (foo (bar\n        baz)\n   |    quux\n zot)")
+    ("  (foo ((bar\n         baz)\n    |    quux)\n zot)"
+     "  (foo (bar\n        baz)\n    |   quux\n zot)")
+    ("  (foo ((bar\n         baz)\n     |   quux)\n zot)"
+     "  (foo (bar\n        baz)\n     |  quux\n zot)")
+    ("  (foo ((bar\n         baz)\n      |  quux)\n zot)"
+     "  (foo (bar\n        baz)\n      | quux\n zot)")
+    ("  (foo ((bar\n         baz)\n       | quux)\n zot)"
+     "  (foo (bar\n        baz)\n       |quux\n zot)")
+    ("  (foo ((bar\n         baz)\n        |quux)\n zot)"
+     "  (foo (bar\n        baz)\n       |quux\n zot)")
+    ("  (foo ((bar\n         baz)\n        q|uux)\n zot)"
+     "  (foo (bar\n        baz)\n       q|uux\n zot)")
+    ("  (foo ((bar\n         baz)\n        qu|ux)\n zot)"
+     "  (foo (bar\n        baz)\n       qu|ux\n zot)")
+    ("  (foo ((bar\n         baz)\n        quu|x)\n zot)"
+     "  (foo (bar\n        baz)\n       quu|x\n zot)")
+    ("  (foo ((bar\n         baz)\n        quux|)\n zot)"
+     "  (foo (bar\n        baz)\n       quux|\n zot)")
+
+    ;; But adjust the whole form's indentation if we change the operator.
+    ("((|let) ((a b))\n       c)" "(|let ((a b))\n  c)")
+    ("((l|et) ((a b))\n       c)" "(l|et ((a b))\n  c)")
+    ("((le|t) ((a b))\n       c)" "(le|t ((a b))\n  c)")
+    ("((let|) ((a b))\n       c)" "(let| ((a b))\n  c)")
+
+    ;; Uh oh -- you can really lose here.
+    ("\"|foo\\\"bar\"" error)
+    ;++ ("(\"|foo\\\;bar\")" error)
+    ))
+
 (defun paredit-canary-indent-method (state indent-point normal-indent)
   (check-parens)
   nil)